home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / chap10 / howto08 / delphi10 / cciccfrm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-06-12  |  156.5 KB  |  4,550 lines
  1. unit Cciccfrm;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, Menus, FileCtrl, CCWSock, CCICCInf,
  8.   CCICCPrf, IniFiles, Gauges , CCUUCode;
  9.  
  10. type
  11.   { This record holds the information for a number of internet connections }
  12.   PConnectionsRecord = ^TConnectionsRecord;
  13.   TConnectionsRecord = record
  14.     CProfile   : String; { Connection profile; used in lists }
  15.     CIPAddress : String; { Dotted character IP Address       }
  16.     CUserName  : String; { Login name to site; can be anonym }
  17.     CPassword  : String; { Password; won't be shown          }
  18.     CStartDir  : String; { Starting directory; used for FTP  }
  19.   end;
  20.   { Array of TCR }
  21.   CRFile = file of TConnectionsRecord; { File type for TCRec }
  22.   { This record is used to hold information about a newsgroup            }
  23.   { NOTE : hi and low pointers indicate either dl or trashing without dl }
  24.   { "read" is for an article dl'd but not trashed.                       }
  25.   PNewsGroupRecord = ^TNewsGroupRecord;
  26.   TNewsGroupRecord = record
  27.     GName                : String;  { Profile of the newsgroup              }
  28.     GRealName            : String;  { Real Newsrc name of the newsgroup     }
  29.     GLowest              : Longint; { Number of lowest dl/trashed article   }
  30.     GHighest             : Longint; { Number of highest dl/trashed article  }
  31.     GTotalNew            : Longint; { Total New articles available          }
  32.     GTotalAvailable      : Longint; { After update, shows how many arts on s}
  33.     GLowestAvailable     : Longint; { au, shows lowest a# on server         }
  34.     GHighestAvailable    : Longint; { au, shows highest a# on server        }
  35.     GPostable            : Boolean; { Can post to newsgroup                 }
  36.     GSubscribed          : Boolean; { Subscribed to newsgroup               }
  37.     GTotalArticles       : Longint; { Total articles maintained on system   }
  38.     GTotalUnReadArticles : Longint; { Total unread articles on system       }
  39.     GIDNumber            : Integer;
  40.     GFileName            : String;  { Name of file holding articles records }
  41.     GLTag                : Longint; { Tag field to hold pointer to arts TL  }
  42.   end;
  43.   NGRFile = file of TNewsGroupRecord; { File type for NGRec }
  44.   { This record is used to hold information about Newsgroup articles }
  45.   PNewsGroupArticleRecord = ^TNewsGroupArticleRecord;
  46.   TNewsGroupArticleRecord = record
  47.     NGAGroupname   : String;  { Newsgroup name (redundancy safeguard)     }
  48.     NGASubject     : String;  { Subject of article                        }
  49.     NGANumber      : Longint; { Article number                            }
  50.     NGADownloaded  : boolean; { Article attempted/succeeded downloading   }
  51.     NGASender      : String;  { Article's putative sender (CIUPKC158=us)  }
  52.     NGARead        : Boolean; { Article read flag                         }
  53.     NGAPosted      : Boolean; { Article posted flag                       }
  54.     NGAArtFileName : String;  { Name of system-gen file with article text }
  55.   end;
  56.   NGARFile = file of TNewsGroupArticleRecord;
  57.   TCCINetCCForm = class(TForm)
  58.     MainMenu1: TMainMenu;
  59.     Network1: TMenuItem;
  60.     N1: TMenuItem;
  61.     Exit1: TMenuItem;
  62.     Services1: TMenuItem;
  63.     IPAddress1: TMenuItem;
  64.     EMail1: TMenuItem;
  65.     FTP1: TMenuItem;
  66.     UsenetNws1: TMenuItem;
  67.     Panel1: TPanel;
  68.     Panel2: TPanel;
  69.     Panel3: TPanel;
  70.     Panel4: TPanel;
  71.     Panel5: TPanel;
  72.     Panel6: TPanel;
  73.     ListBox1: TListBox;
  74.     Panel7: TPanel;
  75.     SpeedButton1: TSpeedButton;
  76.     SpeedButton2: TSpeedButton;
  77.     ListBox2: TListBox;
  78.     ComboBox1: TComboBox;
  79.     Button1: TButton;
  80.     Memo1: TMemo;
  81.     Files1: TMenuItem;
  82.     Edit1: TMenuItem;
  83.     Encoding1: TMenuItem;
  84.     EMail2: TMenuItem;
  85.     FTP2: TMenuItem;
  86.     News1: TMenuItem;
  87.     Load1: TMenuItem;
  88.     Save1: TMenuItem;
  89.     Cut1: TMenuItem;
  90.     Copy1: TMenuItem;
  91.     CopytoFile1: TMenuItem;
  92.     Paste1: TMenuItem;
  93.     PastefromFile1: TMenuItem;
  94.     UUDecode1: TMenuItem;
  95.     MIMEDecode1: TMenuItem;
  96.     UUEncode1: TMenuItem;
  97.     MIMEEncode1: TMenuItem;
  98.     CheckMail1: TMenuItem;
  99.     ReplyToCurrentMessage1: TMenuItem;
  100.     SendCurrentMessage1: TMenuItem;
  101.     SendQueue1: TMenuItem;
  102.     Mailboxes1: TMenuItem;
  103.     Correspondents1: TMenuItem;
  104.     EmptyTrash1: TMenuItem;
  105.     SpeedButton4: TSpeedButton;
  106.     SpeedButton5: TSpeedButton;
  107.     SpeedButton3: TSpeedButton;
  108.     Panel8: TPanel;
  109.     Label1: TLabel;
  110.     Label2: TLabel;
  111.     ComboBox2: TComboBox;
  112.     Label3: TLabel;
  113.     ComboBox3: TComboBox;
  114.     ConnectToSite1: TMenuItem;
  115.     Disconnect1: TMenuItem;
  116.     UploadMarked1: TMenuItem;
  117.     DownloadMarked1: TMenuItem;
  118.     Directory1: TMenuItem;
  119.     ASCII1: TMenuItem;
  120.     Binary1: TMenuItem;
  121.     ASCII2: TMenuItem;
  122.     Binary2: TMenuItem;
  123.     ViewRemoteasText1: TMenuItem;
  124.     FTPSites1: TMenuItem;
  125.     CheckNewNews1: TMenuItem;
  126.     GetMarked1: TMenuItem;
  127.     CreateNewMessage1: TMenuItem;
  128.     Article1: TMenuItem;
  129.     SubscribedNewsgroups1: TMenuItem;
  130.     Trash1: TMenuItem;
  131.     Preferences1: TMenuItem;
  132.     EMail3: TMenuItem;
  133.     FTP3: TMenuItem;
  134.     News2: TMenuItem;
  135.     Label4: TLabel;
  136.     Label5: TLabel;
  137.     ViewasText1: TMenuItem;
  138.     Change1: TMenuItem;
  139.     Create1: TMenuItem;
  140.     Delete3: TMenuItem;
  141.     ChangeLocal1: TMenuItem;
  142.     OpenDialog1: TOpenDialog;
  143.     SaveDialog1: TSaveDialog;
  144.     Paths1: TMenuItem;
  145.     ProgressInfo1: TMenuItem;
  146.     N2: TMenuItem;
  147.     ViewInEditWindow1: TMenuItem;
  148.     ViewInStatusLine1: TMenuItem;
  149.     SaveToFile1: TMenuItem;
  150.     ViewWinsockInfo1: TMenuItem;
  151.     Description1: TMenuItem;
  152.     SystemStatus1: TMenuItem;
  153.     VendorSpecific1: TMenuItem;
  154.     Gauge1: TGauge;
  155.     NewsServers1: TMenuItem;
  156.     AllReadArticles1: TMenuItem;
  157.     AllMarkedArticles1: TMenuItem;
  158.     AllAvailableArticles1: TMenuItem;
  159.     NewArticle1: TMenuItem;
  160.     FollowupArticle1: TMenuItem;
  161.     Post1: TMenuItem;
  162.     CurrentArticle1: TMenuItem;
  163.     EntireQueue1: TMenuItem;
  164.     ConnectandUpdate1: TMenuItem;
  165.     Disconnect2: TMenuItem;
  166.     Headers1: TMenuItem;
  167.     RetrieveMarked1: TMenuItem;
  168.     RetrieveAll1: TMenuItem;
  169.     DownloadActiveNewsgroups1: TMenuItem;
  170.     PutinQueue1: TMenuItem;
  171.     TrashMarkedMessages1: TMenuItem;
  172.     MailServers1: TMenuItem;
  173.     ExitEMailRequired1: TMenuItem;
  174.     ToCurrentMessage1: TMenuItem;
  175.     ToNewMessage1: TMenuItem;
  176.     ToFile2: TMenuItem;
  177.     AbortNewsgroupDownload1: TMenuItem;
  178.     Catchup1: TMenuItem;
  179.     Marked1: TMenuItem;
  180.     All1: TMenuItem;
  181.     File1: TMenuItem;
  182.     SelectedArticle1: TMenuItem;
  183.     SelectMultipleArticles1: TMenuItem;
  184.     DecodeSelections1: TMenuItem;
  185.     procedure Exit1Click(Sender: TObject);
  186.     procedure FormCreate(Sender: TObject);
  187.     procedure FormDestroy(Sender: TObject);
  188.     procedure Description1Click(Sender: TObject);
  189.     procedure SystemStatus1Click(Sender: TObject);
  190.     procedure VendorSpecific1Click(Sender: TObject);
  191.     procedure ViewInEditWindow1Click(Sender: TObject);
  192.     procedure ViewInStatusLine1Click(Sender: TObject);
  193.     procedure SaveToFile1Click(Sender: TObject);
  194.     procedure IPAddress1Click(Sender: TObject);
  195.     procedure FTP1Click(Sender: TObject);
  196.     procedure FormResize(Sender: TObject);
  197.     procedure FTPSites1Click(Sender: TObject);
  198.     procedure FTP3Click(Sender: TObject);
  199.     procedure ConnectToSite1Click(Sender: TObject);
  200.     procedure Button1Click(Sender: TObject);
  201.     procedure ViewasText1Click(Sender: TObject);
  202.     procedure Disconnect1Click(Sender: TObject);
  203.     procedure ToDisplay1Click(Sender: TObject);
  204.     procedure ToFile1Click(Sender: TObject);
  205.     procedure Binary2Click(Sender: TObject);
  206.     procedure Change1Click(Sender: TObject);
  207.     procedure ChangeLocal1Click(Sender: TObject);
  208.     procedure ListBox1DblClick(Sender: TObject);
  209.     procedure ListBox2DblClick(Sender: TObject);
  210.     procedure ASCII1Click(Sender: TObject);
  211.     procedure DeleteRemoteFiles1Click(Sender: TObject);
  212.     procedure Binary1Click(Sender: TObject);
  213.     procedure Delete3Click(Sender: TObject);
  214.     procedure Create1Click(Sender: TObject);
  215.     procedure ListBox1Click(Sender: TObject);
  216.     procedure UsenetNws1Click(Sender: TObject);
  217.     procedure Disconnect2Click(Sender: TObject);
  218.     procedure News2Click(Sender: TObject);
  219.     procedure ConnectandUpdate1Click(Sender: TObject);
  220.     procedure CheckNewNews1Click(Sender: TObject);
  221.     procedure NewsServers1Click(Sender: TObject);
  222.     procedure SubscribedNewsgroups1Click(Sender: TObject);
  223.     procedure RetrieveMarked1Click(Sender: TObject);
  224.     procedure RetrieveAll1Click(Sender: TObject);
  225.     procedure GetMarked1Click(Sender: TObject);
  226.     procedure NewArticle1Click(Sender: TObject);
  227.     procedure FollowupArticle1Click(Sender: TObject);
  228.     procedure PutinQueue1Click(Sender: TObject);
  229.     procedure CurrentArticle1Click(Sender: TObject);
  230.     procedure EntireQueue1Click(Sender: TObject);
  231.     procedure AllReadArticles1Click(Sender: TObject);
  232.     procedure AllMarkedArticles1Click(Sender: TObject);
  233.     procedure AllAvailableArticles1Click(Sender: TObject);
  234.     procedure DownloadActiveNewsgroups1Click(Sender: TObject);
  235.     procedure Load1Click(Sender: TObject);
  236.     procedure Save1Click(Sender: TObject);
  237.     procedure Paths1Click(Sender: TObject);
  238.     procedure Cut1Click(Sender: TObject);
  239.     procedure Copy1Click(Sender: TObject);
  240.     procedure CopytoFile1Click(Sender: TObject);
  241.     procedure Paste1Click(Sender: TObject);
  242.     procedure PastefromFile1Click(Sender: TObject);
  243.     procedure SpeedButton5Click(Sender: TObject);
  244.     procedure SpeedButton1Click(Sender: TObject);
  245.     procedure SpeedButton2Click(Sender: TObject);
  246.     procedure ListBox2Click(Sender: TObject);
  247.     procedure AbortNewsgroupDownload1Click(Sender: TObject);
  248.     procedure Marked1Click(Sender: TObject);
  249.     procedure All1Click(Sender: TObject);
  250.     procedure File1Click(Sender: TObject);
  251.     procedure SelectedArticle1Click(Sender: TObject);
  252.     procedure SelectMultipleArticles1Click(Sender: TObject);
  253.     procedure DecodeSelections1Click(Sender: TObject);
  254.     procedure SpeedButton4Click(Sender: TObject);
  255.   private
  256.     { Private declarations }
  257.   public
  258.     { Public declarations }
  259.     procedure EnableFTPMenus;
  260.     procedure DisableFTPMenus;
  261.     procedure EnableNNTPMenus;
  262.     procedure DisableNNTPMenus;
  263.     procedure UpdateGauge( BytesFinished , TotalToHandle : longint );
  264.     procedure UpdateUUGauge( BytesFinished , TotalToHandle : longint );
  265.     function DoFTPConnection( PCRPointer : PConnectionsRecord ) : boolean;
  266.     function DoNNTPConnection( PCRPointer : PConnectionsRecord ) : boolean;
  267.     procedure DoFTPDisconnect;
  268.     procedure DoNNTPDisconnect;
  269.     procedure ReadIniData;
  270.     procedure WriteIniData;
  271.     procedure LoadFTPSiteFile;
  272.     procedure LoadNNTPSiteFile;
  273.     procedure SetupNNTPServersInfoDisplay;
  274.     procedure SaveFTPSiteFile;
  275.     procedure SetupFTPSiteLists;
  276.     procedure SaveNNTPSiteFile;
  277.     procedure SetupNNTPSiteLists;
  278.     procedure SetupNNTPNewsGroupsInfoDisplay;
  279.     procedure SetupNNTPNewsGroupLists;
  280.     procedure SaveNNTPNewsGroupLists;
  281.     procedure SetupNewsGroupListboxes;
  282.     procedure PopulateLB2WithArticleHeaders;
  283.     procedure AddNullTermTextToMemo( TheTextToAdd   : String;
  284.                                      TheMemoToAddTo : TMemo   );
  285.     function AddNullTermTextToLabel( TheTextToAdd   : String ) : String;
  286.     procedure SetHGCursors;
  287.     procedure SetNormalCursors;
  288.     procedure AddProgressText( WhatText : String );
  289.     procedure ShowProgressText( WhatText : String );
  290.     procedure ShowProgressErrorText( WhatText : String );
  291.     procedure SocketsErrorOccurred( Sender     : TObject;
  292.                                      ErrorCode  : Integer;
  293.                                      TheMessage : String   );
  294.   end;
  295.   { Component to hold FTP handling capabilities }
  296.   TFTPComponent = class( TWinControl )
  297.   public
  298.     FTPCommandInProgress ,
  299.     Connection_Established : Boolean;
  300.     Socket1 : TCCSocket;
  301.     Socket2 : TCCSocket;
  302.     constructor Create( AOwner : TComponent ); override;
  303.     destructor Destroy; override;
  304.     function GetTotalBytesToReceive( TheString : String ) : Longint;
  305.     function StripBrackets( TheString : String ) : String;
  306.     function GetShortPathname( TheString : String ) : String;
  307.     function GetWin16FileName( InputName : String ) : String;
  308.     function GetRemoteWorkingDirectory( var RemoteDir : String ) : Boolean;
  309.     function SetRemoteDirectory( TheDir : String ) : Boolean;
  310.     function DeleteRemoteDirectory( TheDir : String ) : Boolean;
  311.     function CreateRemoteDirectory( TheDir : String ) : Boolean;
  312.     function DeleteRemoteFile( TheFileName : String ) : Boolean;
  313.     function EstablishConnection( PCRPointer : PConnectionsRecord ) : Boolean;
  314.     function LoginUser( PCRPointer : PConnectionsRecord ) : Boolean;
  315.     function SendPassword( PCRPointer : PConnectionsRecord ) : Boolean;
  316.     function SetRemoteStartupDirectory( PCRPointer : PConnectionsRecord )
  317.               : Boolean;
  318.     function GetRemoteDirectoryListing( TheListBox : TListBox ) : Boolean;
  319.     function GetRemoteDirectoryListingToMemo : Boolean;
  320.     procedure SendASCIILocalFile( LocalName : String );
  321.     procedure SendBinaryLocalFile( LocalName : String );
  322.     procedure ReceiveASCIIRemoteFile( RemoteName , LocalName : String );
  323.     procedure ReceiveBinaryRemoteFile( RemoteName , LocalName : String );
  324.     function GetLocalDirectoryAndListing( var TheString : String;
  325.                                               TheListBox : TListBox )
  326.               : Boolean;
  327.     function GetUNIXTextString( var StringIn : String ) : String;
  328.     procedure ReceiveASCIIRemoteFileToMemo( RemoteName : String );
  329.     function GetListeningPort : Integer;
  330.     procedure GetFileNameFromUNIXFileName( var TheName : String );
  331.     function Disconnect : Boolean;
  332.     function DoCStyleFormat(       TheText      : string;
  333.                              const TheArguments : array of const ) : String;
  334.     procedure UpdateGauge( BytesFinished , TotalToHandle : longint );
  335.     function GetQuotedString( TheString : String ) : String;
  336.     procedure AddProgressText( WhatText : String );
  337.     procedure ShowProgressText( WhatText : String );
  338.     procedure ShowProgressErrorText( WhatText : String );
  339.     function GetFTPServerResponse( var ResponseString : String ) : integer;
  340.     procedure FTPSocketsErrorOccurred( Sender     : TObject;
  341.                                      ErrorCode  : Integer;
  342.                                      TheMessage : String   );
  343.     function PerformFTPCommand(
  344.                     TheCommand   : string;
  345.               const TheArguments : array of const ) : Integer;
  346.   end;
  347. const
  348.   POV_MEMO                 = 1; { Progress to the Memo           }
  349.   POV_STAT                 = 2; { Progress to the status caption }
  350.   TCPIP_STATUS_PRELIMINARY   = 1; { Wait; command being processed  }
  351.   TCPIP_STATUS_COMPLETED     = 2; { Done; command fully succeded   }
  352.   TCPIP_STATUS_CONTINUING    = 3; { OK; send more data to finish   }
  353.   TCPIP_STATUS_RETRY_COMMAND = 4; { Temporary Error; try cmd again }
  354.   TCPIP_STATUS_FATAL_ERROR   = 5; { Fatal Error; don't retry cmd   }
  355.  
  356. var
  357.   CCINetCCForm         : TCCINetCCForm;
  358.   GlobalErrorCode      : Integer;        { Used to pass around error info  }
  359.   GlobalAbortedFlag    : Boolean;        { Used to signal timeout error    }
  360.   ProgressList         : TStringList;    { Used to hold progress text info }
  361.   ProgressFileName     : String;         { Used to hold progress file name }
  362.   ProgressOutputVector : Integer;        { Used to direct progress output  }
  363.   TheFTPSiteList       : TList;          { Used to store the FTP site recs }
  364.   TheWorkingFTPSL      : TList;          { Used to store working copy of l }
  365.   TheNewsServerList    : TList;          { Used to hold list of NNTP servs }
  366.   TheWorkingNSSL       : TList;          { Used for working copy of above  }
  367.   TheEMailServerList   : TList;          { Used for list of POP3/SMTP serv }
  368.   TheWorkingEMSL       : TList;          { Used for working copy of above  }
  369.   TheNewsRCList        : TList;          { Used for list of available ngs  }
  370.   TheWorkingNRCSL      : TList;          { Used for working copy of above  }
  371.   TheNGArticlesList    : TList;          { Used for current articles list  }
  372.                                          { (will hot swap from pointer of  }
  373.                                          {  Tlist of Tlists in base rec.)  }
  374.   TheNewsServerFile    : CRFile;         { File of NNTP servers records    }
  375.   TheNewsRCFile        : NGRFile;        { File of Newsgroups records      }
  376.   TheNewsArticleFile   : NGARFile;       { Current ng articles records file}
  377.   TheFTPSiteFile       : CRFile;         { Used to load the FTP site file  }
  378.   TheICCIniFile        : TIniFile;       { Used to retrieve the INI File   }
  379.   MailPath             : String;         { Used for path to Mail Files     }
  380.   NewsPath             : String;         { Used for path to News Files     }
  381.   FTPPath              : String;         { Used for path to FTP Files      }
  382.   CurrentPassWordString : String;        { Used to hold login id for anons }
  383.   CurrentEMPassWordString : String;      { Used to hold login id for anons }
  384.   PassWordControlVector : Integer;       { Used to hold display of pw vect }
  385.   CurrentRealPWString   : String;        { Used to hold a real password    }
  386.   EMPassWordControlVector : Integer;       { Used to hold display of pw vect }
  387.   CurrentEMRealPWString   : String;        { Used to hold a real password    }
  388.   TheFTPComponent       : TFTPComponent; { FTP Object                      }
  389.   TheLine ,
  390.   HolderLine ,
  391.   GlobalTextBuffer      : String;
  392.   TheAnonRedialVector ,
  393.   DefaultDownloadVector : Integer;
  394.   NewsReadArticlePurgingVector : Integer;
  395.   NewsPostQueueingVector : Integer;
  396.   NewsReadArticleDisplayVector : Integer;
  397.   NewsUUMIMEVector : Integer;
  398.   NewsInitialUpdateVector : Integer;
  399.   LeftoverText          : String;
  400.   LeftoversOnTable      : Boolean;
  401.   FileNameToXFer        : String;
  402.   WhichServer           : Integer;       { Holds current NNTP server }
  403.   WhichGroup            : Integer;       { Holds current NNTP newsgroup }
  404.   TheUUObject           : TUUCodingObject;
  405.   EMRemoteDeletionVector : Integer;
  406.   EMChokeVector : Integer;
  407.   EMDefaultDownloadVector : Integer;
  408.   EMQueueVector : Integer;
  409.   NewsgroupListLoaded ,
  410.   EmailLoaded ,
  411.   NewMessageInProgress : Boolean;
  412.   TheUUDecodeList      : TStringList;
  413.   
  414. implementation
  415.  
  416. uses CCICNNTP;
  417.  
  418. var
  419.   TheNNTPComponent      : TNNTPComponent;{ NNTP News Object                }
  420.  
  421. {$R *.DFM}
  422.  
  423.  
  424.  
  425. { This is the FTP component constructor; it creates 2 sockets }
  426. constructor TFTPComponent.Create( AOwner : TComponent );
  427. begin
  428.   { do inherited create }
  429.   inherited Create( AOwner );
  430.   { Create sockets, put in their parents, and error procs }
  431.   Socket1 := TCCSocket.Create( Self );
  432.   Socket1.Parent := Self;
  433.   Socket1.OnErrorOccurred := FTPSocketsErrorOccurred;
  434.   Socket2 := TCCSocket.Create( Self );
  435.   Socket2.Parent := Self;
  436.   Socket2.OnErrorOccurred := FTPSocketsErrorOccurred;
  437.   { Set up booleans }
  438.   Connection_Established := false;
  439.   FTPCommandInProgress := false;
  440. end;
  441.  
  442. { This is the FTP component destructor; it frees 2 sockets }
  443. destructor TFTPComponent.Destroy;
  444. begin
  445.   { Free the sockets }
  446.   Socket1.Free;
  447.   Socket2.Free;
  448.   { and call inherited }
  449.   inherited Destroy;
  450. end;
  451.  
  452. function TFTPComponent.GetShortPathname( TheString : String ) : String;
  453. var HoldingString : String;
  454. begin
  455.   HoldingString := Copy( TheString , 1 , 3 );
  456.   HoldingString := HoldingString + '..\' + ExtractFileName( TheString );
  457.   Result := HoldingString;
  458. end;
  459.  
  460. function TFTPComponent.StripBrackets( TheString : String ) : String;
  461. var HoldingString : String;
  462.     HoldingPosition : Integer;
  463. begin
  464.   HoldingPosition := Pos( '[' , TheString );
  465.   if HoldingPosition = 0 then
  466.   begin
  467.     Result := TheString;
  468.     exit;
  469.   end
  470.   else
  471.   begin
  472.     HoldingString := Copy( TheString , HoldingPosition + 1 , 255 );
  473.     HoldingPosition := Pos( ']' , HoldingString );
  474.     if HoldingPosition = 0 then
  475.     begin
  476.       Result := HoldingString;
  477.       exit;
  478.     end
  479.     else
  480.     begin
  481.       HoldingString := Copy( HoldingString , 1 , HoldingPosition - 1 );
  482.       Result := HoldingString;
  483.       exit;
  484.     end;
  485.   end;
  486. end;
  487.  
  488. { This function takes a UNIX filespec and turns it into a Win16 filename }
  489. function TFTPComponent.GetWin16FileName( InputName : String ) : String;
  490. var WorkingString ,
  491.     HoldingString   : String; { Holding string }
  492. begin
  493.   WorkingString := ExtractFileExt( InputName );
  494.   if WorkingString = '' then
  495.   begin
  496.     if Length( InputName ) > 8 then
  497.      WorkingString := Copy( InputName , 1 , 8 ) else
  498.       WorkingString := InputName;
  499.   end
  500.   else
  501.   begin
  502.     if Length( WorkingString ) > 4 then
  503.      WorkingString := Copy( WorkingString , 1 , 4 );
  504.     HoldingString :=
  505.      Copy( InputName , 1 , Pos( WorkingString , InputName ) - 1 );
  506.     if Length( HoldingString ) > 8 then
  507.      HoldingString := Copy( HoldingString , 1 , 8 );
  508.     if HoldingString = '' then
  509.     begin
  510.       { Dot file }
  511.       HoldingString := Copy( InputName , 2 , 255 ) + '.TXT';
  512.       WorkingString := HoldingString;
  513.     end
  514.     else WorkingString := HoldingString + WorkingString;
  515.   end;
  516.   Result := WorkingString;
  517. end;
  518.  
  519. { This sends a local file in binary mode to the remote server }
  520. procedure TFTPComponent.SendBinaryLocalFile( LocalName : String );
  521. var TheReturnString : String;  { Internal string holder }
  522.     TheResult       : Integer; { Internal int holder    }
  523.     Through         : Boolean;
  524.     FileNamePChar   : array[ 0 .. 255 ] of char;
  525.     OutputFileHandle : Integer;
  526.     TotalBytesSent ,
  527.     BytesRead ,
  528.     FileToSendSize    : Longint;
  529.     CopyBuffer       : array[ 0 .. 255 ] of char absolute TheReturnString;
  530. begin
  531.   LocalName := ExpandFileName( LocalName );
  532.   StrPCopy( FileNamePChar , LocalName );
  533.   OutputFileHandle := _lopen( FileNamePChar , 0 );
  534.   if OutputFileHandle = -1 then
  535.   begin
  536.     MessageDlg( 'Cannot Open local file ' + LocalName ,
  537.      mtError , [mbOK] , 0 );
  538.     exit;
  539.   end;
  540.   FileToSendSize := _llseek( OutputFileHandle , 0 , 2 );
  541.   _llseek( OutputFileHandle , 0 , 0 );
  542.   TheReturnString :=
  543.    DoCStyleFormat( 'TYPE I' ,
  544.     [ nil ] );
  545.   { Put result in progress and status line }
  546.   AddProgressText( TheReturnString );
  547.   ShowProgressText( TheReturnString );
  548.   { Send Password sequence }
  549.   TheResult := PerformFTPCommand( 'TYPE I',
  550.                                   [ nil ] );
  551.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  552.   begin
  553.     FTPCommandInProgress := false;
  554.     exit;
  555.   end;
  556.   repeat
  557.     TheResult := GetFTPServerResponse( TheReturnString );
  558.     { Put result in progress and status line }
  559.     AddProgressText( TheReturnString );
  560.     ShowProgressText( TheReturnString );
  561.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  562.   FTPCommandInProgress := false;
  563.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  564.   begin
  565.     { Do clever C formatting trick }
  566.     TheReturnString :=
  567.      DoCStyleFormat( 'FTP File Send Failed!' ,
  568.       [ nil ] );
  569.     { Put result in progress and status line }
  570.     AddProgressText( TheReturnString );
  571.     ShowProgressErrorText( TheReturnString );
  572.     { leave }
  573.     exit;
  574.   end
  575.   else
  576.   begin
  577.     { Set up socket 2 for listening }
  578.     Socket2.AsynchMode := False;
  579.     Socket2.NonAsynchTimeoutValue := 60;
  580.     { do a listen and send command to server that this is receipt socket }
  581.     if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
  582.     begin
  583.       Socket2.CCSockCancelListen;
  584.       exit;
  585.     end;
  586.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  587.     TheReturnString :=
  588.      DoCStyleFormat( 'STOR %s' ,
  589.       [ ExtractFileName( LocalName ) ] );
  590.     { Put result in progress and status line }
  591.     AddProgressText( TheReturnString );
  592.     ShowProgressText( TheReturnString );
  593.     TheResult := PerformFTPCommand( 'STOR %s' , [ ExtractFileName( LocalName ) ] );
  594.     GetFTPServerResponse( TheReturnString );
  595.     AddProgressText( TheReturnString );
  596.     ShowProgressText( TheReturnString );
  597.     Socket1.NonAsynchTimeoutValue := 30;
  598.     if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
  599.        ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
  600.     begin
  601.       TheReturnString :=
  602.        DoCStyleFormat( 'Could not create remote file!' ,
  603.         [ nil ] );
  604.       { Put result in progress and status line }
  605.       AddProgressText( TheReturnString );
  606.       ShowProgressErrorText( TheReturnString );
  607.       Socket2.CCSockCancelListen;
  608.       exit;
  609.     end;
  610.     Socket2.CCSockAccept;
  611.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  612.     begin
  613.       TheReturnString :=
  614.        DoCStyleFormat( 'Could not establish send socket!' ,
  615.         [ nil ] );
  616.       { Put result in progress and status line }
  617.       AddProgressText( TheReturnString );
  618.       ShowProgressErrorText( TheReturnString );
  619.       exit;
  620.     end;
  621.     Through := false;
  622.     TotalBytesSent := 0;
  623.     BytesRead := _lread( OutputFileHandle , @CopyBuffer[ 1 ] , 255 );
  624.     repeat
  625.       if BytesRead = 0 then Through := true;
  626.       if BytesRead > 0 then
  627.       begin
  628.         CopyBuffer[ 0 ] := Chr( BytesRead );
  629.         Socket2.StringData := TheReturnString;
  630.         TotalBytesSent := TotalBytesSent + BytesRead;
  631.         UpdateGauge( TotalBytesSent , FileToSendSize );
  632.         BytesRead := _lread( OutputFileHandle , @CopyBuffer[ 1 ] , 255 );
  633.         if BytesRead = -1 then
  634.         begin
  635.           MessageDlg( 'File Read Error on ' + LocalName , mtError , [mbOK] , 0 );
  636.           GlobalAbortedFlag := True;
  637.         end;
  638.       end;
  639.       if GlobalAbortedFlag then
  640.       begin
  641.         Socket1.OutOfBand := 'ABOR'+#13#10;
  642.         repeat
  643.           TheResult := GetFTPServerResponse( TheReturnString );
  644.           { Put result in progress and status line }
  645.           AddProgressText( TheReturnString );
  646.           ShowProgressText( TheReturnString );
  647.         until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  648.         exit;
  649.       end;
  650.     until Through;
  651.     FTPCommandInProgress := false;
  652.     { cancel listening on second socket and close it }
  653.     Socket2.CCSockCancelListen;
  654.     Socket2.CCSockClose;
  655.     TheReturnString := 'Transfer Succeeded' + #13#10;
  656.     AddProgressText( TheReturnString );
  657.     ShowProgressText( TheReturnString );
  658.     FTPCommandInProgress := false;
  659.     PerformFTPCommand( 'TYPE A',
  660.                                     [ nil ] );
  661.     Through := false;
  662.     repeat
  663.       GetFTPServerResponse( TheReturnString );
  664.       if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
  665.        Through := true;
  666.       { Put result in progress and status line }
  667.       AddProgressText( TheReturnString );
  668.       ShowProgressText( TheReturnString );
  669.     until (( GlobalAbortedFlag ) or Through );
  670.   end;
  671.   _lclose( OutputFileHandle );
  672.   FTPCommandInProgress := false;
  673. end;
  674.  
  675. { This sends a local file in ascii mode to remote server }
  676. procedure TFTPComponent.SendASCIILocalFile( LocalName : String );
  677. var TheReturnString : String;  { Internal string holder }
  678.     TheResult       : Integer; { Internal int holder    }
  679.     Through         : Boolean;
  680.     FileNamePChar   : array[ 0 .. 255 ] of char;
  681.     OutputFileHandle : Integer;
  682.     TotalBytesSent ,
  683.     BytesRead ,
  684.     FileToSendSize    : Longint;
  685.     CopyBuffer       : array[ 0 .. 255 ] of char absolute TheReturnString;
  686. begin
  687.   LocalName := ExpandFileName( LocalName );
  688.   StrPCopy( FileNamePChar , LocalName );
  689.   OutputFileHandle := _lopen( FileNamePChar , 0 );
  690.   if OutputFileHandle = -1 then
  691.   begin
  692.     MessageDlg( 'Cannot Open local file ' + LocalName ,
  693.      mtError , [mbOK] , 0 );
  694.     exit;
  695.   end;
  696.   FileToSendSize := _llseek( OutputFileHandle , 0 , 2 );
  697.   _llseek( OutputFileHandle , 0 , 0 );
  698.   TheReturnString :=
  699.    DoCStyleFormat( 'TYPE A' ,
  700.     [ nil ] );
  701.   { Put result in progress and status line }
  702.   AddProgressText( TheReturnString );
  703.   ShowProgressText( TheReturnString );
  704.   { Send Password sequence }
  705.   TheResult := PerformFTPCommand( 'TYPE A',
  706.                                   [ nil ] );
  707.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  708.   begin
  709.     FTPCommandInProgress := false;
  710.     exit;
  711.   end;
  712.   repeat
  713.     TheResult := GetFTPServerResponse( TheReturnString );
  714.     { Put result in progress and status line }
  715.     AddProgressText( TheReturnString );
  716.     ShowProgressText( TheReturnString );
  717.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  718.   FTPCommandInProgress := false;
  719.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  720.   begin
  721.     { Do clever C formatting trick }
  722.     TheReturnString :=
  723.      DoCStyleFormat( 'FTP File Send Failed!' ,
  724.       [ nil ] );
  725.     { Put result in progress and status line }
  726.     AddProgressText( TheReturnString );
  727.     ShowProgressErrorText( TheReturnString );
  728.     { leave }
  729.     exit;
  730.   end
  731.   else
  732.   begin
  733.     { Set up socket 2 for listening }
  734.     Socket2.AsynchMode := False;
  735.     Socket2.NonAsynchTimeoutValue := 60;
  736.     { do a listen and send command to server that this is receipt socket }
  737.     if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
  738.     begin
  739.       Socket2.CCSockCancelListen;
  740.       exit;
  741.     end;
  742.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  743.     TheReturnString :=
  744.      DoCStyleFormat( 'STOR %s' ,
  745.       [ ExtractFileName( LocalName ) ] );
  746.     { Put result in progress and status line }
  747.     AddProgressText( TheReturnString );
  748.     ShowProgressText( TheReturnString );
  749.     TheResult := PerformFTPCommand( 'STOR %s' , [ ExtractFileName( LocalName )]);
  750.     GetFTPServerResponse( TheReturnString );
  751.     AddProgressText( TheReturnString );
  752.     ShowProgressText( TheReturnString );
  753.     Socket1.NonAsynchTimeoutValue := 30;
  754.     if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
  755.        ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
  756.     begin
  757.       TheReturnString :=
  758.        DoCStyleFormat( 'Could not create remote file!' ,
  759.         [ nil ] );
  760.       { Put result in progress and status line }
  761.       AddProgressText( TheReturnString );
  762.       ShowProgressErrorText( TheReturnString );
  763.       Socket2.CCSockCancelListen;
  764.       exit;
  765.     end;
  766.     Socket2.CCSockAccept;
  767.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  768.     begin
  769.       TheReturnString :=
  770.        DoCStyleFormat( 'Could not establish send socket!' ,
  771.         [ nil ] );
  772.       { Put result in progress and status line }
  773.       AddProgressText( TheReturnString );
  774.       ShowProgressErrorText( TheReturnString );
  775.       exit;
  776.     end;
  777.     Through := false;
  778.     TotalBytesSent := 0;
  779.     BytesRead := _lread( OutputFileHandle , @CopyBuffer[ 1 ] , 255 );
  780.     repeat
  781.       if BytesRead = 0 then Through := true;
  782.       if BytesRead > 0 then
  783.       begin
  784.         CopyBuffer[ 0 ] := Chr( BytesRead );
  785.         Socket2.StringData := TheReturnString;
  786.         TotalBytesSent := TotalBytesSent + BytesRead;
  787.         UpdateGauge( TotalBytesSent , FileToSendSize );
  788.         BytesRead := _lread( OutputFileHandle , @CopyBuffer[ 1 ] , 255 );
  789.         if BytesRead = -1 then
  790.         begin
  791.           MessageDlg( 'File Read Error on ' + LocalName , mtError , [mbOK] , 0 );
  792.           GlobalAbortedFlag := True;
  793.         end;
  794.       end;
  795.       if GlobalAbortedFlag then
  796.       begin
  797.         Socket1.OutOfBand := 'ABOR'+#13#10;
  798.         repeat
  799.           TheResult := GetFTPServerResponse( TheReturnString );
  800.           { Put result in progress and status line }
  801.           AddProgressText( TheReturnString );
  802.           ShowProgressText( TheReturnString );
  803.         until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  804.         exit;
  805.       end;
  806.     until Through;
  807.     { cancel listening on second socket and close it }
  808.     Socket2.CCSockCancelListen;
  809.     Socket2.CCSockClose;
  810.     TheReturnString := 'Transfer Succeeded' + #13#10;
  811.     AddProgressText( TheReturnString );
  812.     ShowProgressText( TheReturnString );
  813.     FTPCommandInProgress := false;
  814.     PerformFTPCommand( 'TYPE A', [ nil ] );
  815.     Through := false;
  816.     repeat
  817.       GetFTPServerResponse( TheReturnString );
  818.       if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
  819.        Through := true;
  820.       { Put result in progress and status line }
  821.       AddProgressText( TheReturnString );
  822.       ShowProgressText( TheReturnString );
  823.     until (( GlobalAbortedFlag ) or Through );
  824.   end;
  825.   _lclose( OutputFileHandle );
  826.   FTPCommandInProgress := false;
  827. end;
  828.  
  829. { This function strips out the FTP response for bytes to send }
  830. function TFTPComponent.GetTotalBytesToReceive( TheString : String ) : Longint;
  831. var
  832.   LeftPosition ,
  833.   RightPosition  : integer;
  834.   TempString     : string;
  835. begin
  836.   LeftPosition := Pos( '(' , TheString );
  837.   TempString := Copy( TheString ,
  838.                       LeftPosition + 1 , 255 );
  839.   RightPosition := Pos( ' ' , TempString );
  840.   if (( LeftPosition = 0 ) or ( RightPosition = 0 )) then
  841.   begin
  842.     Result := 0;
  843.     exit;
  844.   end;
  845.   if RightPosition <> 0 then
  846.     TempString := Copy( TempString , 1 , RightPosition - 1  );
  847.   try
  848.     Result := StrToInt( TempString );
  849.   except
  850.     on EConvertError do Result := 0;
  851.   end;
  852. end;
  853.  
  854. procedure TFTPComponent.UpdateGauge( BytesFinished , TotalToHandle : longint );
  855. begin
  856.   CCInetCCForm.UpdateGauge( BytesFinished , TotalToHandle );
  857. end;
  858.  
  859. { This sends FTP progress text to the Inet form }
  860. procedure TFTPComponent.AddProgressText( WhatText : String );
  861. begin
  862.   CCInetCCForm.AddProgressText( WhatText );
  863. end;
  864.  
  865. { This sends FTP progress text to the Inet form }
  866. procedure TFTPComponent.ShowProgressText( WhatText : String );
  867. begin
  868.   CCInetCCForm.ShowProgressText( WhatText );
  869. end;
  870.  
  871. { This procedure receives a binary remote file }
  872. procedure TFTPComponent.ReceiveASCIIRemoteFileToMemo( RemoteName : String );
  873. var TheReturnString : String;  { Internal string holder }
  874.     TheResult       : Integer; { Internal int holder    }
  875.     Through         : Boolean;
  876.     TotalBytesSent ,
  877.     FileToGetSize    : Longint;
  878. begin
  879.   TheReturnString :=
  880.    DoCStyleFormat( 'TYPE A' ,
  881.     [ nil ] );
  882.   { Put result in progress and status line }
  883.   AddProgressText( TheReturnString );
  884.   ShowProgressText( TheReturnString );
  885.   { Send Password sequence }
  886.   FTPCommandInProgress := false;
  887.   TheResult := PerformFTPCommand( 'TYPE A',
  888.                                   [ nil ] );
  889.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  890.   begin
  891.     FTPCommandInProgress := false;
  892.     exit;
  893.   end;
  894.   repeat
  895.     TheResult := GetFTPServerResponse( TheReturnString );
  896.     { Put result in progress and status line }
  897.     AddProgressText( TheReturnString );
  898.     ShowProgressText( TheReturnString );
  899.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  900.   FTPCommandInProgress := false;
  901.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  902.   begin
  903.     { Do clever C formatting trick }
  904.     TheReturnString :=
  905.      DoCStyleFormat( 'FTP File Receive Failed!' ,
  906.       [ nil ] );
  907.     { Put result in progress and status line }
  908.     AddProgressText( TheReturnString );
  909.     ShowProgressErrorText( TheReturnString );
  910.     { leave }
  911.     exit;
  912.   end
  913.   else
  914.   begin
  915.     { Set up socket 2 for listening }
  916.     Socket2.AsynchMode := False;
  917.     Socket2.NonAsynchTimeoutValue := 60;
  918.     { do a listen and send command to server that this is receipt socket }
  919.     if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
  920.     begin
  921.       Socket2.CCSockCancelListen;
  922.       exit;
  923.     end;
  924.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  925.     TheReturnString :=
  926.      DoCStyleFormat( 'RETR %s' ,
  927.       [ RemoteName ] );
  928.     { Put result in progress and status line }
  929.     AddProgressText( TheReturnString );
  930.     ShowProgressText( TheReturnString );
  931.     TheResult := PerformFTPCommand( 'RETR %s' , [RemoteName] );
  932.     GetFTPServerResponse( TheReturnString );
  933.     AddProgressText( TheReturnString );
  934.     ShowProgressText( TheReturnString );
  935.     FileToGetSize := GetTotalBytesToReceive( TheReturnString );
  936.     Socket1.NonAsynchTimeoutValue := 30;
  937.     if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
  938.        ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
  939.     begin
  940.       TheReturnString :=
  941.        DoCStyleFormat( 'Could not obtain remote file!' ,
  942.         [ nil ] );
  943.       { Put result in progress and status line }
  944.       AddProgressText( TheReturnString );
  945.       ShowProgressErrorText( TheReturnString );
  946.       Socket2.CCSockCancelListen;
  947.       exit;
  948.     end;
  949.     Socket2.CCSockAccept;
  950.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  951.     begin
  952.       TheReturnString :=
  953.        DoCStyleFormat( 'Could not establish receive socket!' ,
  954.         [ nil ] );
  955.       { Put result in progress and status line }
  956.       AddProgressText( TheReturnString );
  957.       ShowProgressErrorText( TheReturnString );
  958.       exit;
  959.     end;
  960.     Through := false;
  961.     TotalBytesSent := 0;
  962.     repeat
  963.       TheReturnString := Socket2.StringData;
  964.       if Length( TheReturnString ) = 0 then Through := true;
  965.       if Length( TheReturnString ) > 0 then
  966.       begin
  967.         TotalBytesSent := TotalBytesSent + Length( TheReturnString );
  968.         UpdateGauge( TotalBytesSent , FileToGetSize );
  969.         { Put result in progress and status line }
  970.         AddProgressText( TheReturnString );
  971.         ShowProgressText( TheReturnString );
  972.       end;
  973.       if GlobalAbortedFlag then
  974.       begin
  975.         Socket1.OutOfBand := 'ABOR'+#13#10;
  976.         repeat
  977.           TheResult := GetFTPServerResponse( TheReturnString );
  978.           { Put result in progress and status line }
  979.           AddProgressText( TheReturnString );
  980.           ShowProgressText( TheReturnString );
  981.         until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  982.         exit;
  983.       end;
  984.     until Through;
  985.     { cancel listening on second socket and close it }
  986.     Socket2.CCSockCancelListen;
  987.     Socket2.CCSockClose;
  988.     FTPCommandInProgress := false;
  989.     PerformFTPCommand( 'TYPE A', [ nil ] );
  990.     Through := false;
  991.     repeat
  992.       GetFTPServerResponse( TheReturnString );
  993.       if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
  994.        Through := true;
  995.       { Put result in progress and status line }
  996.       AddProgressText( TheReturnString );
  997.       ShowProgressText( TheReturnString );
  998.     until (( GlobalAbortedFlag ) or Through );
  999.   end;
  1000.   FTPCommandInProgress := false;
  1001. end;
  1002.  
  1003. { This procedure receives a binary remote file }
  1004. procedure TFTPComponent.ReceiveASCIIRemoteFile( RemoteName , LocalName : String );
  1005. var TheReturnString : String;  { Internal string holder }
  1006.     TheResult       : Integer; { Internal int holder    }
  1007.     Through         : Boolean;
  1008.     FileNamePChar   : array[ 0 .. 255 ] of char;
  1009.     OutputFileHandle : Integer;
  1010.     TotalBytesSent ,
  1011.     FileToGetSize    : Longint;
  1012.     CopyBuffer       : array[ 0 .. 255 ] of char;
  1013. begin
  1014.   LocalName := ExpandFileName( LocalName );
  1015.   StrPCopy( FileNamePChar , LocalName );
  1016.   OutputFileHandle := _lcreat( FileNamePChar , 0 );
  1017.   if OutputFileHandle = -1 then
  1018.   begin
  1019.     MessageDlg( 'Cannot Create local file ' + LocalName ,
  1020.      mtError , [mbOK] , 0 );
  1021.     exit;
  1022.   end;
  1023.   TheReturnString :=
  1024.    DoCStyleFormat( 'TYPE A' ,
  1025.     [ nil ] );
  1026.   { Put result in progress and status line }
  1027.   AddProgressText( TheReturnString );
  1028.   ShowProgressText( TheReturnString );
  1029.   { Send Password sequence }
  1030.   TheResult := PerformFTPCommand( 'TYPE A',
  1031.                                   [ nil ] );
  1032.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1033.   begin
  1034.     FTPCommandInProgress := false;
  1035.     exit;
  1036.   end;
  1037.   repeat
  1038.     TheResult := GetFTPServerResponse( TheReturnString );
  1039.     { Put result in progress and status line }
  1040.     AddProgressText( TheReturnString );
  1041.     ShowProgressText( TheReturnString );
  1042.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1043.   FTPCommandInProgress := false;
  1044.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1045.   begin
  1046.     { Do clever C formatting trick }
  1047.     TheReturnString :=
  1048.      DoCStyleFormat( 'FTP File Receive Failed!' ,
  1049.       [ nil ] );
  1050.     { Put result in progress and status line }
  1051.     AddProgressText( TheReturnString );
  1052.     ShowProgressErrorText( TheReturnString );
  1053.     { leave }
  1054.     exit;
  1055.   end
  1056.   else
  1057.   begin
  1058.     { Set up socket 2 for listening }
  1059.     Socket2.AsynchMode := False;
  1060.     Socket2.NonAsynchTimeoutValue := 60;
  1061.     { do a listen and send command to server that this is receipt socket }
  1062.     if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
  1063.     begin
  1064.       Socket2.CCSockCancelListen;
  1065.       exit;
  1066.     end;
  1067.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  1068.     TheReturnString :=
  1069.      DoCStyleFormat( 'RETR %s' ,
  1070.       [ RemoteName ] );
  1071.     { Put result in progress and status line }
  1072.     AddProgressText( TheReturnString );
  1073.     ShowProgressText( TheReturnString );
  1074.     TheResult := PerformFTPCommand( 'RETR %s' , [RemoteName] );
  1075.     GetFTPServerResponse( TheReturnString );
  1076.     AddProgressText( TheReturnString );
  1077.     ShowProgressText( TheReturnString );
  1078.     FileToGetSize := GetTotalBytesToReceive( TheReturnString );
  1079.     Socket1.NonAsynchTimeoutValue := 30;
  1080.     if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
  1081.        ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
  1082.     begin
  1083.       TheReturnString :=
  1084.        DoCStyleFormat( 'Could not obtain remote file!' ,
  1085.         [ nil ] );
  1086.       { Put result in progress and status line }
  1087.       AddProgressText( TheReturnString );
  1088.       ShowProgressErrorText( TheReturnString );
  1089.       Socket2.CCSockCancelListen;
  1090.       exit;
  1091.     end;
  1092.     Socket2.CCSockAccept;
  1093.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  1094.     begin
  1095.       TheReturnString :=
  1096.        DoCStyleFormat( 'Could not establish receive socket!' ,
  1097.         [ nil ] );
  1098.       { Put result in progress and status line }
  1099.       AddProgressText( TheReturnString );
  1100.       ShowProgressErrorText( TheReturnString );
  1101.       exit;
  1102.     end;
  1103.     Through := false;
  1104.     TotalBytesSent := 0;
  1105.     repeat
  1106.       TheReturnString := Socket2.StringData;
  1107.       if Length( TheReturnString ) = 0 then Through := true;
  1108.       if Length( TheReturnString ) > 0 then
  1109.       begin
  1110.         StrPCopy( CopyBuffer , TheReturnString );
  1111.         TotalBytesSent := TotalBytesSent + Length( TheReturnString );
  1112.         UpdateGauge( TotalBytesSent , FileToGetSize );
  1113.         if _lwrite( OutputFileHandle , CopyBuffer , Length( TheReturnString ))
  1114.          = -1 then
  1115.         begin
  1116.           MessageDlg( 'File Write Error on ' + LocalName , mtError , [mbOK] , 0 );
  1117.           GlobalAbortedFlag := True;
  1118.         end;
  1119.       end;
  1120.       if GlobalAbortedFlag then
  1121.       begin
  1122.         Socket1.OutOfBand := 'ABOR'+#13#10;
  1123.         repeat
  1124.           TheResult := GetFTPServerResponse( TheReturnString );
  1125.           { Put result in progress and status line }
  1126.           AddProgressText( TheReturnString );
  1127.           ShowProgressText( TheReturnString );
  1128.         until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1129.         exit;
  1130.       end;
  1131.     until Through;
  1132.     { cancel listening on second socket and close it }
  1133.     Socket2.CCSockCancelListen;
  1134.     Socket2.CCSockClose;
  1135.     FTPCommandInProgress := false;
  1136.     PerformFTPCommand( 'TYPE A', [ nil ] );
  1137.     Through := false;
  1138.     repeat
  1139.       GetFTPServerResponse( TheReturnString );
  1140.       if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
  1141.        Through := true;
  1142.       { Put result in progress and status line }
  1143.       AddProgressText( TheReturnString );
  1144.       ShowProgressText( TheReturnString );
  1145.     until (( GlobalAbortedFlag ) or Through );
  1146.   end;
  1147.   _lclose( OutputFileHandle );
  1148.   FTPCommandInProgress := false;
  1149. end;
  1150.  
  1151. { This procedure receives a binary remote file }
  1152. procedure TFTPComponent.ReceiveBinaryRemoteFile( RemoteName , LocalName : String );
  1153. var TheReturnString : String;  { Internal string holder }
  1154.     TheResult       : Integer; { Internal int holder    }
  1155.     Through         : Boolean;
  1156.     FileNamePChar   : array[ 0 .. 255 ] of char;
  1157.     OutputFileHandle : Integer;
  1158.     TotalBytesSent ,
  1159.     FileToGetSize    : Longint;
  1160.     CopyBuffer       : array[ 0 .. 255 ] of char;
  1161. begin
  1162.   LocalName := ExpandFileName( LocalName );
  1163.   StrPCopy( FileNamePChar , LocalName );
  1164.   OutputFileHandle := _lcreat( FileNamePChar , 0 );
  1165.   if OutputFileHandle = -1 then
  1166.   begin
  1167.     MessageDlg( 'Cannot Create local file ' + LocalName ,
  1168.      mtError , [mbOK] , 0 );
  1169.     exit;
  1170.   end;
  1171.   TheReturnString :=
  1172.    DoCStyleFormat( 'TYPE I' ,
  1173.     [ nil ] );
  1174.   { Put result in progress and status line }
  1175.   AddProgressText( TheReturnString );
  1176.   ShowProgressText( TheReturnString );
  1177.   { Send Password sequence }
  1178.   TheResult := PerformFTPCommand( 'TYPE I',
  1179.                                   [ nil ] );
  1180.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1181.   begin
  1182.     FTPCommandInProgress := false;
  1183.     exit;
  1184.   end;
  1185.   repeat
  1186.     TheResult := GetFTPServerResponse( TheReturnString );
  1187.     { Put result in progress and status line }
  1188.     AddProgressText( TheReturnString );
  1189.     ShowProgressText( TheReturnString );
  1190.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1191.   FTPCommandInProgress := false;
  1192.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1193.   begin
  1194.     { Do clever C formatting trick }
  1195.     TheReturnString :=
  1196.      DoCStyleFormat( 'FTP File Receive Failed!' ,
  1197.       [ nil ] );
  1198.     { Put result in progress and status line }
  1199.     AddProgressText( TheReturnString );
  1200.     ShowProgressErrorText( TheReturnString );
  1201.     { leave }
  1202.     exit;
  1203.   end
  1204.   else
  1205.   begin
  1206.     { Set up socket 2 for listening }
  1207.     Socket2.AsynchMode := False;
  1208.     Socket2.NonAsynchTimeoutValue := 60;
  1209.     { do a listen and send command to server that this is receipt socket }
  1210.     if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
  1211.     begin
  1212.       Socket2.CCSockCancelListen;
  1213.       exit;
  1214.     end;
  1215.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  1216.     TheReturnString :=
  1217.      DoCStyleFormat( 'RETR %s' ,
  1218.       [ RemoteName ] );
  1219.     { Put result in progress and status line }
  1220.     AddProgressText( TheReturnString );
  1221.     ShowProgressText( TheReturnString );
  1222.     TheResult := PerformFTPCommand( 'RETR %s' , [RemoteName] );
  1223.     GetFTPServerResponse( TheReturnString );
  1224.     AddProgressText( TheReturnString );
  1225.     ShowProgressText( TheReturnString );
  1226.     FileToGetSize := GetTotalBytesToReceive( TheReturnString );
  1227.     Socket1.NonAsynchTimeoutValue := 30;
  1228.     if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
  1229.        ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
  1230.     begin
  1231.       TheReturnString :=
  1232.        DoCStyleFormat( 'Could not obtain remote file!' ,
  1233.         [ nil ] );
  1234.       { Put result in progress and status line }
  1235.       AddProgressText( TheReturnString );
  1236.       ShowProgressErrorText( TheReturnString );
  1237.       Socket2.CCSockCancelListen;
  1238.       exit;
  1239.     end;
  1240.     Socket2.CCSockAccept;
  1241.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  1242.     begin
  1243.       TheReturnString :=
  1244.        DoCStyleFormat( 'Could not establish receive socket!' ,
  1245.         [ nil ] );
  1246.       { Put result in progress and status line }
  1247.       AddProgressText( TheReturnString );
  1248.       ShowProgressErrorText( TheReturnString );
  1249.       exit;
  1250.     end;
  1251.     Through := false;
  1252.     TotalBytesSent := 0;
  1253.     repeat
  1254.       TheReturnString := Socket2.StringData;
  1255.       if Length( TheReturnString ) = 0 then Through := true;
  1256.       if Length( TheReturnString ) > 0 then
  1257.       begin
  1258.         StrPCopy( CopyBuffer , TheReturnString );
  1259.         TotalBytesSent := TotalBytesSent + Length( TheReturnString );
  1260.         UpdateGauge( TotalBytesSent , FileToGetSize );
  1261.         if _lwrite( OutputFileHandle , CopyBuffer , Length( TheReturnString ))
  1262.          = -1 then
  1263.         begin
  1264.           MessageDlg( 'File Write Error on ' + LocalName , mtError , [mbOK] , 0 );
  1265.           GlobalAbortedFlag := True;
  1266.         end;
  1267.       end;
  1268.       if GlobalAbortedFlag then
  1269.       begin
  1270.         Socket1.OutOfBand := 'ABOR'+#13#10;
  1271.         repeat
  1272.           TheResult := GetFTPServerResponse( TheReturnString );
  1273.           { Put result in progress and status line }
  1274.           AddProgressText( TheReturnString );
  1275.           ShowProgressText( TheReturnString );
  1276.         until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1277.         exit;
  1278.       end;
  1279.     until Through;
  1280.     { cancel listening on second socket and close it }
  1281.     Socket2.CCSockCancelListen;
  1282.     Socket2.CCSockClose;
  1283.     FTPCommandInProgress := false;
  1284.     PerformFTPCommand( 'TYPE A', [ nil ] );
  1285.     Through := false;
  1286.     repeat
  1287.       GetFTPServerResponse( TheReturnString );
  1288.       if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
  1289.        Through := true;
  1290.       { Put result in progress and status line }
  1291.       AddProgressText( TheReturnString );
  1292.       ShowProgressText( TheReturnString );
  1293.     until (( GlobalAbortedFlag ) or Through );
  1294.   end;
  1295.   _lclose( OutputFileHandle );
  1296.   FTPCommandInProgress := false;
  1297. end;
  1298.  
  1299. { This sends FTP progress text to the Inet form }
  1300. procedure TFTPComponent.ShowProgressErrorText( WhatText : String );
  1301. begin
  1302.   CCInetCCForm.ShowProgressErrorText( WhatText );
  1303. end;
  1304.  
  1305. { This is a core function! It performs an FTP command and if no timeout }
  1306. { return a preliminary ok.                                              }
  1307. function TFTPComponent.PerformFTPCommand(
  1308.                  TheCommand        : string;
  1309.            const TheArguments      : array of const ) : Integer;
  1310. var TheBuffer : string; { Text buffer }
  1311. begin
  1312.   { If command in progress send back -1 error }
  1313.   if FTPCommandInProgress then
  1314.   begin
  1315.     Result := -1;
  1316.     exit;
  1317.   end;
  1318.   { Set status variable }
  1319.   FTPCommandInProgress := True;
  1320.   { Set global error code }
  1321.   GlobalErrorCode := 0;
  1322.   { Format output string }
  1323.   TheBuffer := Format( TheCommand , TheArguments );
  1324.   { Preset failure code }
  1325.   Result := TCPIP_STATUS_FATAL_ERROR;
  1326.   { If invalid socket or no connection abort }
  1327.   if ( Socket1.TheSocket = INVALID_SOCKET ) or not Connection_Established then
  1328.    exit;
  1329.   { Send the buffer plus EOL chars }
  1330.   Socket1.StringData := TheBuffer + #13#10;
  1331.   { if abort due to timeout or other error exit }
  1332.   if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  1333.   { Otherwise return preliminary code }
  1334.   Result := TCPIP_STATUS_PRELIMINARY;
  1335. end;
  1336.  
  1337. { This function gets up to 255 chars of data plus a return code from FTP serv }
  1338. function TFTPComponent.GetFTPServerResponse(
  1339.           var ResponseString : String ) : integer;
  1340. var
  1341.   { Buffer string for response line }
  1342.   TheBuffer     : string;
  1343.   { Pointer to the response string }
  1344.   BufferPointer : array[0..255] of char absolute TheBuffer;
  1345.   { Character to check for response code }
  1346.   ResponseChar   : char;
  1347.   { Pointers into returned string }
  1348.   TheIndex ,
  1349.   TheLength     : integer;
  1350.   { Control variable }
  1351.   LeftoversInPan ,
  1352.   Finished      : Boolean;
  1353. begin
  1354.   { Preset fatal error }
  1355.   Result := TCPIP_STATUS_FATAL_ERROR;
  1356.   { Start loop control }
  1357.   LeftoversInPan := false;
  1358.   Finished := false;
  1359.   repeat
  1360.     { Do a peek }
  1361.     TheBuffer := Socket1.PeekData;
  1362.     { If timeout or other error exit }
  1363.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  1364.     { Find end of line character }
  1365.     TheIndex := Pos( #10 , TheBuffer );
  1366.     if TheIndex = 0 then
  1367.     begin
  1368.       TheIndex := Pos( #13 , TheBuffer );
  1369.       if TheIndex = 0 then
  1370.       begin
  1371.         TheIndex := Pos( #0 , TheBuffer );
  1372.         if TheIndex = 0 then
  1373.         begin
  1374.           TheIndex := Length( TheBuffer );
  1375.           LeftoversInPan := True;
  1376.           LeftoverText := LeftoverText + TheBuffer;
  1377.           LeftoversOnTable := false;
  1378.         end;
  1379.       end;
  1380.     end;
  1381.     { If an end of line then process the line }
  1382.     if TheIndex > 0 then
  1383.     begin
  1384.       { Get length of string }
  1385.       TheLength := TheIndex;
  1386.       { Receive actual data }
  1387.       Socket1.CCSockReceive( Socket1.TheSocket   ,
  1388.                              @BufferPointer[ 1 ] ,
  1389.                              TheLength              );
  1390.       { Abort if timeout or error }
  1391.       if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  1392.       { Put in the length byte }
  1393.       BufferPointer[ 0 ] := Chr( TheLength );
  1394.       if LeftOversOnTable then
  1395.       begin
  1396.         LeftOversOnTable := false;
  1397.         ResponseString := LeftoverText + TheBuffer;
  1398.         TheBuffer := ResponseString;
  1399.         LeftoverText := '';
  1400.       end;
  1401.       if LeftoversInPan then
  1402.       begin
  1403.         LeftoversInPan := false;
  1404.         LeftoversOnTable := true;
  1405.       end;
  1406.       { If not a continuation line }
  1407.       if TheBuffer[ 4 ] <> '-' then
  1408.       begin
  1409.         { Get first number character }
  1410.         ResponseChar := TheBuffer[ 1 ];
  1411.         { Get the value of the number from 1 to 5 }
  1412.         if (( ResponseChar >= '1' ) and ( ResponseChar <= '5' )) then
  1413.         begin
  1414.           Finished := true;
  1415.           Result := Ord( ResponseChar ) - 48;
  1416.         end;
  1417.       end
  1418.       else
  1419.       begin
  1420.         { otherwise return preliminary result }
  1421.         Finished := true;
  1422.         Result := TCPIP_STATUS_PRELIMINARY;
  1423.       end;
  1424.     end
  1425.     else
  1426.     begin
  1427.     end;
  1428.   until ( Finished and ( not LeftoversOnTable ));
  1429.   { Return buffer as response string }
  1430.   ResponseString := TheBuffer;
  1431. end;
  1432.  
  1433. { Boilerplate error routine }
  1434. procedure TFTPComponent.FTPSocketsErrorOccurred( Sender     : TObject;
  1435.                                                  ErrorCode  : Integer;
  1436.                                                  TheMessage : String   );
  1437. begin
  1438.   CCInetCCForm.SocketsErrorOccurred( Sender,ErrorCode,TheMessage );
  1439. end;
  1440.  
  1441. { This is the FTP components initial connection routine }
  1442. function TFTPComponent.EstablishConnection(
  1443.           PCRPointer : PConnectionsRecord ) : Boolean;
  1444. var TheReturnString : String;  { Internal string holder }
  1445.     TheResult       : Integer; { Internal int holder    }
  1446. begin
  1447.   { Set default FTP Port value }
  1448.   Socket1.PortName := '21';
  1449.   { Get the ip address from the record }
  1450.   Socket1.IPAddressName := PCRPointer^.CIPAddress;
  1451.   { Set blocking mode }
  1452.   Socket1.AsynchMode := False;
  1453.   { Clear condition variables }
  1454.   GlobalErrorCode := 0;
  1455.   GlobalAbortedFlag := false;
  1456.   { Actually attempt to connect }
  1457.   Socket1.CCSockConnect;
  1458.   { Check if connected }
  1459.   if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 ) or
  1460.       ( Socket1.TheSocket = INVALID_SOCKET )) then
  1461.   begin { Didn't connect; signal error and abort }
  1462.     { Do clever C formatting trick }
  1463.     TheReturnString :=
  1464.      DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  1465.       [ PCRPointer^.CIPAddress ] );
  1466.     { Put result in progress and status line }
  1467.     AddProgressText( TheReturnString );
  1468.     ShowProgressErrorText( TheReturnString );
  1469.     { Signal error }
  1470.     Result := False;
  1471.     { leave }
  1472.     exit;
  1473.   end
  1474.   else
  1475.   begin
  1476.     Connection_Established := true;
  1477.     { Signal successful connection }
  1478.     TheReturnString := DoCStyleFormat(
  1479.       'Connected on Local port: %s with IP: %s',
  1480.       [ Socket1.GetSocketPort( Socket1.TheSocket ),
  1481.         Socket1.GetSocketIPAddress( Socket1.TheSocket )]);
  1482.     { Put result in progress and status line }
  1483.     CCINetCCForm.AddProgressText( TheReturnString );
  1484.     CCINetCCForm.ShowProgressText( TheReturnString );
  1485.     TheReturnString := DoCStyleFormat(
  1486.      'Connected to Remote port: %s with IP: %s',
  1487.       [ Socket1.GetSocketPeerPort( Socket1.TheSocket ),
  1488.         Socket1.GetSocketPeerIPAddress( Socket1.TheSocket )]);
  1489.     { Put result in progress and status line }
  1490.     CCINetCCForm.AddProgressText( TheReturnString );
  1491.     CCINetCCForm.ShowProgressText( TheReturnString );
  1492.     TheReturnString := DoCStyleFormat( 'Successfully connected to %s',
  1493.      [ Socket1.IPAddressName ]);
  1494.     { Put result in progress and status line }
  1495.     CCINetCCForm.AddProgressText( TheReturnString );
  1496.     CCINetCCForm.ShowProgressText( TheReturnString );
  1497.     repeat
  1498.       TheResult := GetFTPServerResponse( TheReturnString );
  1499.       { Put result in progress and status line }
  1500.       AddProgressText( TheReturnString );
  1501.       ShowProgressText( TheReturnString );
  1502.     until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1503.     if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1504.     begin
  1505.       { Do clever C formatting trick }
  1506.       TheReturnString :=
  1507.        DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  1508.         [ PCRPointer^.CIPAddress ] );
  1509.       { Put result in progress and status line }
  1510.       AddProgressText( TheReturnString );
  1511.       ShowProgressErrorText( TheReturnString );
  1512.       { Signal error }
  1513.       Result := False;
  1514.       { leave }
  1515.       exit;
  1516.     end
  1517.     else Result := true; { Signal no problem }
  1518.   end;
  1519. end;
  1520.  
  1521. { This is the FTP components USER login routine }
  1522. function TFTPComponent.LoginUser(
  1523.           PCRPointer : PConnectionsRecord ) : Boolean;
  1524. var TheReturnString : String;  { Internal string holder }
  1525.     TheResult       : Integer; { Internal int holder    }
  1526. begin
  1527.   TheReturnString :=
  1528.    DoCStyleFormat( 'USER %s' ,
  1529.     [ PCRPointer^.CUserName ] );
  1530.   { Put result in progress and status line }
  1531.   AddProgressText( TheReturnString );
  1532.   ShowProgressText( TheReturnString );
  1533.   { Begin login sequence with user name }
  1534.   TheResult := PerformFTPCommand( 'USER %s',
  1535.                                   [ PCRPointer^.CUserName ] );
  1536.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1537.   begin
  1538.     FTPCommandInProgress := false;
  1539.     Result := false;
  1540.     exit;
  1541.   end;
  1542.   repeat
  1543.     TheResult := GetFTPServerResponse( TheReturnString );
  1544.     { Put result in progress and status line }
  1545.     AddProgressText( TheReturnString );
  1546.     ShowProgressText( TheReturnString );
  1547.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1548.   FTPCommandInProgress := false;
  1549.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_CONTINUING )) then
  1550.   begin
  1551.     { Do clever C formatting trick }
  1552.     TheReturnString :=
  1553.      DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  1554.       [ PCRPointer^.CIPAddress ] );
  1555.     { Put result in progress and status line }
  1556.     AddProgressText( TheReturnString );
  1557.     ShowProgressErrorText( TheReturnString );
  1558.     { Signal error }
  1559.     Result := False;
  1560.     { leave }
  1561.     exit;
  1562.   end
  1563.   else Result := true; { Signal no problem }
  1564. end;
  1565.  
  1566. function TFTPComponent.DeleteRemoteDirectory( TheDir : String ) : Boolean;
  1567. var TheReturnString : String;  { Internal string holder }
  1568.     TheResult       : Integer; { Internal int holder    }
  1569. begin
  1570.   TheReturnString := DoCStyleFormat( 'RMD %s' ,
  1571.    [ TheDir ] );
  1572.   { Put result in progress and status line }
  1573.   AddProgressText( TheReturnString );
  1574.   ShowProgressText( TheReturnString );
  1575.   { Send Password sequence }
  1576.   TheResult := PerformFTPCommand( 'RMD %s',
  1577.                                   [ TheDir ] );
  1578.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1579.   begin
  1580.     Result := false;
  1581.     FTPCommandInProgress := false;
  1582.     exit;
  1583.   end;
  1584.   repeat
  1585.     TheResult := GetFTPServerResponse( TheReturnString );
  1586.     { Put result in progress and status line }
  1587.     AddProgressText( TheReturnString );
  1588.     ShowProgressText( TheReturnString );
  1589.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1590.   FTPCommandInProgress := false;
  1591.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1592.   begin
  1593.     { Do clever C formatting trick }
  1594.     TheReturnString :=
  1595.      DoCStyleFormat( 'Delete Directory %s Failed!' ,
  1596.       [ TheDir ] );
  1597.     { Put result in progress and status line }
  1598.     AddProgressText( TheReturnString );
  1599.     ShowProgressErrorText( TheReturnString );
  1600.     { Signal error }
  1601.     Result := False;
  1602.     { leave }
  1603.     exit;
  1604.   end
  1605.   else Result := true; { Signal no problem }
  1606. end;
  1607.  
  1608. function TFTPComponent.CreateRemoteDirectory( TheDir : String ) : Boolean;
  1609. var TheReturnString : String;  { Internal string holder }
  1610.     TheResult       : Integer; { Internal int holder    }
  1611. begin
  1612.   TheReturnString := DoCStyleFormat( 'MKD %s' ,
  1613.     [ TheDir ] );
  1614.   { Put result in progress and status line }
  1615.   AddProgressText( TheReturnString );
  1616.   ShowProgressText( TheReturnString );
  1617.   { Send Password sequence }
  1618.   TheResult := PerformFTPCommand( 'MKD %s',
  1619.                                   [ TheDir ] );
  1620.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1621.   begin
  1622.     Result := false;
  1623.     FTPCommandInProgress := false;
  1624.     exit;
  1625.   end;
  1626.   repeat
  1627.     TheResult := GetFTPServerResponse( TheReturnString );
  1628.     { Put result in progress and status line }
  1629.     AddProgressText( TheReturnString );
  1630.     ShowProgressText( TheReturnString );
  1631.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1632.   FTPCommandInProgress := false;
  1633.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1634.   begin
  1635.     { Do clever C formatting trick }
  1636.     TheReturnString :=
  1637.      DoCStyleFormat( 'Create Directory %s Failed!' ,
  1638.       [ TheDir ] );
  1639.     { Put result in progress and status line }
  1640.     AddProgressText( TheReturnString );
  1641.     ShowProgressErrorText( TheReturnString );
  1642.     { Signal error }
  1643.     Result := False;
  1644.     { leave }
  1645.     exit;
  1646.   end
  1647.   else Result := true; { Signal no problem }
  1648. end;
  1649.  
  1650.  
  1651. function TFTPComponent.DeleteRemoteFile( TheFileName : String ) : Boolean;
  1652. var TheReturnString : String;  { Internal string holder }
  1653.     TheResult       : Integer; { Internal int holder    }
  1654. begin
  1655.   TheReturnString := DoCStyleFormat( 'DELE %s' ,
  1656.     [ TheFileName ] );
  1657.   { Put result in progress and status line }
  1658.   AddProgressText( TheReturnString );
  1659.   ShowProgressText( TheReturnString );
  1660.   { Send Password sequence }
  1661.   TheResult := PerformFTPCommand( 'DELE %s',
  1662.                                   [ TheFileName ] );
  1663.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1664.   begin
  1665.     Result := false;
  1666.     FTPCommandInProgress := false;
  1667.     exit;
  1668.   end;
  1669.   repeat
  1670.     TheResult := GetFTPServerResponse( TheReturnString );
  1671.     { Put result in progress and status line }
  1672.     AddProgressText( TheReturnString );
  1673.     ShowProgressText( TheReturnString );
  1674.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1675.   FTPCommandInProgress := false;
  1676.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1677.   begin
  1678.     { Do clever C formatting trick }
  1679.     TheReturnString :=
  1680.      DoCStyleFormat( 'Delete File %s Failed!' ,
  1681.       [ TheFileName ] );
  1682.     { Put result in progress and status line }
  1683.     AddProgressText( TheReturnString );
  1684.     ShowProgressErrorText( TheReturnString );
  1685.     { Signal error }
  1686.     Result := False;
  1687.     { leave }
  1688.     exit;
  1689.   end
  1690.   else Result := true; { Signal no problem }
  1691. end;
  1692.  
  1693. { This is the FTP components PASSWORD routine }
  1694. function TFTPComponent.SendPassword(
  1695.           PCRPointer : PConnectionsRecord ) : Boolean;
  1696. var TheReturnString : String;  { Internal string holder }
  1697.     TheResult       : Integer; { Internal int holder    }
  1698. begin
  1699.   TheReturnString := 'PASS XXXXXX' + #13#10;
  1700.   { Put result in progress and status line }
  1701.   AddProgressText( TheReturnString );
  1702.   ShowProgressText( TheReturnString );
  1703.   { Send Password sequence }
  1704.   TheResult := PerformFTPCommand( 'PASS %s',
  1705.                                   [ PCRPointer^.CPassword ] );
  1706.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1707.   begin
  1708.     Result := false;
  1709.     FTPCommandInProgress := false;
  1710.     exit;
  1711.   end;
  1712.   repeat
  1713.     TheResult := GetFTPServerResponse( TheReturnString );
  1714.     { Put result in progress and status line }
  1715.     AddProgressText( TheReturnString );
  1716.     ShowProgressText( TheReturnString );
  1717.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1718.   FTPCommandInProgress := false;
  1719.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1720.   begin
  1721.     { Do clever C formatting trick }
  1722.     TheReturnString :=
  1723.      DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  1724.       [ PCRPointer^.CIPAddress ] );
  1725.     { Put result in progress and status line }
  1726.     AddProgressText( TheReturnString );
  1727.     ShowProgressErrorText( TheReturnString );
  1728.     { Signal error }
  1729.     Result := False;
  1730.     { leave }
  1731.     exit;
  1732.   end
  1733.   else Result := true; { Signal no problem }
  1734. end;
  1735.  
  1736. { This is the FTP components CWD routine }
  1737. function TFTPComponent.SetRemoteStartupDirectory(
  1738.           PCRPointer : PConnectionsRecord ) : Boolean;
  1739. var TheReturnString : String;  { Internal string holder }
  1740.     TheResult       : Integer; { Internal int holder    }
  1741. begin
  1742.   Result := true;
  1743.   if PCRPointer^.CStartDir <> '' then
  1744.   begin
  1745.     TheReturnString :=
  1746.      DoCStyleFormat( 'CWD %s' ,
  1747.       [ PCRPointer^.CStartDir ] );
  1748.     { Put result in progress and status line }
  1749.     AddProgressText( TheReturnString );
  1750.     ShowProgressText( TheReturnString );
  1751.     { Send Password sequence }
  1752.     TheResult := PerformFTPCommand( 'CWD %s',
  1753.                                     [ PCRPointer^.CStartDir ] );
  1754.     if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1755.     begin
  1756.       Result := false;
  1757.       FTPCommandInProgress := false;
  1758.       exit;
  1759.     end;
  1760.     repeat
  1761.       TheResult := GetFTPServerResponse( TheReturnString );
  1762.       { Put result in progress and status line }
  1763.       AddProgressText( TheReturnString );
  1764.       ShowProgressText( TheReturnString );
  1765.    until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1766.    FTPCommandInProgress := false;
  1767.    if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1768.     begin
  1769.       { Do clever C formatting trick }
  1770.       TheReturnString :=
  1771.        DoCStyleFormat( 'CWD to %s Failed!' ,
  1772.         [ PCRPointer^.CStartDir ] );
  1773.       { Put result in progress and status line }
  1774.       AddProgressText( TheReturnString );
  1775.       ShowProgressErrorText( TheReturnString );
  1776.       { Signal error }
  1777.       Result := False;
  1778.       { leave }
  1779.       exit;
  1780.     end
  1781.     else Result := true; { Signal no problem }
  1782.   end;
  1783. end;
  1784.  
  1785. { This is the FTP components CWD routine }
  1786. function TFTPComponent.SetRemoteDirectory( TheDir : String ) : Boolean;
  1787. var TheReturnString : String;  { Internal string holder }
  1788.     TheResult       : Integer; { Internal int holder    }
  1789. begin
  1790.   Result := true;
  1791.   if TheDir <> '' then
  1792.   begin
  1793.     TheReturnString :=
  1794.      DoCStyleFormat( 'CWD %s' ,
  1795.       [ TheDir ] );
  1796.     { Put result in progress and status line }
  1797.     AddProgressText( TheReturnString );
  1798.     ShowProgressText( TheReturnString );
  1799.     { Send Password sequence }
  1800.     TheResult := PerformFTPCommand( 'CWD %s',
  1801.                                     [ TheDir ] );
  1802.     if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1803.     begin
  1804.       Result := false;
  1805.       FTPCommandInProgress := false;
  1806.       exit;
  1807.     end;
  1808.     repeat
  1809.       TheResult := GetFTPServerResponse( TheReturnString );
  1810.       { Put result in progress and status line }
  1811.       AddProgressText( TheReturnString );
  1812.       ShowProgressText( TheReturnString );
  1813.    until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1814.    FTPCommandInProgress := false;
  1815.    if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1816.     begin
  1817.       { Do clever C formatting trick }
  1818.       TheReturnString :=
  1819.        DoCStyleFormat( 'CWD to %s Failed!' ,
  1820.         [ TheDir ] );
  1821.       { Put result in progress and status line }
  1822.       AddProgressText( TheReturnString );
  1823.       ShowProgressErrorText( TheReturnString );
  1824.       { Signal error }
  1825.       Result := False;
  1826.       { leave }
  1827.       exit;
  1828.     end
  1829.     else Result := true; { Signal no problem }
  1830.   end;
  1831. end;
  1832.  
  1833. { This is the FTP components QUIT routine }
  1834. function TFTPComponent.Disconnect : Boolean;
  1835. var TheReturnString : String;  { Internal string holder }
  1836.     TheResult       : Integer; { Internal int holder    }
  1837. begin
  1838.   TheReturnString :=
  1839.    DoCStyleFormat( 'QUIT' ,
  1840.     [ nil ] );
  1841.   { Put result in progress and status line }
  1842.   AddProgressText( TheReturnString );
  1843.   ShowProgressText( TheReturnString );
  1844.   { Begin login sequence with user name }
  1845.   PerformFTPCommand( 'QUIT', [ nil ] );
  1846.   repeat
  1847.     TheResult := GetFTPServerResponse( TheReturnString );
  1848.     { Put result in progress and status line }
  1849.     AddProgressText( TheReturnString );
  1850.     ShowProgressText( TheReturnString );
  1851.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1852.   FTPCommandInProgress := false;
  1853.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1854.   begin
  1855.     { Do clever C formatting trick }
  1856.     TheReturnString :=
  1857.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  1858.       [ nil ] );
  1859.     { Put result in progress and status line }
  1860.     AddProgressText( TheReturnString );
  1861.     ShowProgressErrorText( TheReturnString );
  1862.     { Signal error }
  1863.     Result := False;
  1864.     { leave }
  1865.     exit;
  1866.   end
  1867.   else Result := true; { Signal no problem }
  1868. end;
  1869.  
  1870. { This is the FTP components PWD routine }
  1871. function TFTPComponent.GetRemoteWorkingDirectory( var RemoteDir : String )
  1872.           : Boolean;
  1873. var TheReturnString : String;  { Internal string holder }
  1874.     TheResult       : Integer; { Internal int holder    }
  1875. begin
  1876.   TheReturnString :=
  1877.    DoCStyleFormat( 'PWD' ,
  1878.     [ nil ] );
  1879.   { Put result in progress and status line }
  1880.   AddProgressText( TheReturnString );
  1881.   ShowProgressText( TheReturnString );
  1882.   { Send Password sequence }
  1883.   TheResult := PerformFTPCommand( 'PWD',
  1884.                                   [ nil ] );
  1885.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1886.   begin
  1887.     Result := false;
  1888.     FTPCommandInProgress := false;
  1889.     exit;
  1890.   end;
  1891.   repeat
  1892.     TheResult := GetFTPServerResponse( TheReturnString );
  1893.     { Put result in progress and status line }
  1894.     AddProgressText( TheReturnString );
  1895.     ShowProgressText( TheReturnString );
  1896.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1897.   FTPCommandInProgress := false;
  1898.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1899.   begin
  1900.     { Do clever C formatting trick }
  1901.     TheReturnString :=
  1902.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  1903.       [ nil ] );
  1904.     { Put result in progress and status line }
  1905.     AddProgressText( TheReturnString );
  1906.     ShowProgressErrorText( TheReturnString );
  1907.     { Signal error }
  1908.     Result := False;
  1909.     { leave }
  1910.     exit;
  1911.   end
  1912.   else
  1913.   begin
  1914.     Result := true; { Signal no problem }
  1915.     RemoteDir := TheReturnString; { Send back last string on faith }
  1916.   end;
  1917. end;
  1918.  
  1919. { This function sets up a listening port on socekt 2 and handle text replies }
  1920. function TFTPComponent.GetListeningPort : Integer;
  1921. var
  1922.   Address1 ,
  1923.   Address2 ,
  1924.   Address3 ,
  1925.   Address4        : integer; { Address integer conversions }
  1926.   IPAddress       : string;  { IP Address holder           }
  1927.   PortCommand     : string;  { Command holder              }
  1928.   TheResult       : Integer; { Result holder               }
  1929.   TheReturnString : String;  { ditto                       }
  1930. begin
  1931.   { Set up any port on socket 2 }
  1932.   Socket2.PortName := '0';
  1933.   { Listen on a socket }
  1934.   Socket2.CCSockListen;
  1935.   { Get the IP Address of socket 1 and convert it to numbers }
  1936.   IPAddress := Socket1.GetSocketIPAddress( Socket1.TheSocket );
  1937.   Address1 := StrToInt( copy( IPAddress , 1 , Pos( '.' , IPAddress ) -1 ));
  1938.   IPAddress := copy( IPAddress , Pos( '.' , IPAddress ) + 1 , 255 );
  1939.   Address2 := StrToInt( copy( IPAddress , 1 , Pos( '.' , IPAddress) -1 ));
  1940.   IPAddress := copy( IPAddress , Pos( '.' , IPAddress ) + 1 , 255 );
  1941.   Address3 := StrToInt( copy( IPAddress , 1 , Pos( '.' , IPAddress ) -1 ));
  1942.   Address4 := StrToInt( copy( IPAddress , Pos( '.' , IPAddress ) + 1 , 255 ));
  1943.   { Turn it into a command and add socket 2 stuff }
  1944.   PortCommand := format( 'PORT %d,%d,%d,%d,%d,%d' ,
  1945.    [ Address1 , Address2 , Address3 , Address4 ,
  1946.     StrToInt( Socket2.GetSocketPort( Socket2.TheMasterSocket )) Shr 8,
  1947.     StrToInt( Socket2.GetSocketPort( Socket2.TheMasterSocket )) and $ff ]);
  1948.   { Put result in progress and status line }
  1949.   AddProgressText( PortCommand + #13#10 );
  1950.   ShowProgressText( PortCommand  + #13#10 );
  1951.   TheResult := PerformFTPCommand( PortCommand , [nil] );
  1952.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1953.   begin
  1954.     Result := TCPIP_STATUS_FATAL_ERROR;
  1955.     FTPCommandInProgress := false;
  1956.     exit;
  1957.   end;
  1958.   repeat
  1959.     TheResult := GetFTPServerResponse( TheReturnString );
  1960.     { Put result in progress and status line }
  1961.     AddProgressText( TheReturnString );
  1962.     ShowProgressText( TheReturnString );
  1963.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1964.   FTPCommandInProgress := false;
  1965.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1966.   begin
  1967.     { Do clever C formatting trick }
  1968.     TheReturnString :=
  1969.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  1970.       [ nil ] );
  1971.     { Put result in progress and status line }
  1972.     AddProgressText( TheReturnString );
  1973.     ShowProgressErrorText( TheReturnString );
  1974.     { Signal error }
  1975.     Result := TheResult;
  1976.     { leave }
  1977.     exit;
  1978.   end
  1979.   else
  1980.   begin
  1981.     { Return good result and leave }
  1982.     Result := TheResult;
  1983.     exit;
  1984.   end;
  1985. end;
  1986.  
  1987. { This function returns part of a unit text string }
  1988. function TFTPComponent.GetUNIXTextString( var StringIn : String ) : String;
  1989. var
  1990.   ReturnString : String;
  1991.   TheLength ,
  1992.   Counter_1   : integer;
  1993. begin
  1994.   TheLength := Length( StringIn );
  1995.   if TheLength > 1 then
  1996.   begin
  1997.     for Counter_1 := 1 to TheLength do
  1998.     begin
  1999.       if StringIn[ Counter_1 ] = #10 then
  2000.       begin
  2001.         ReturnString := HolderLine;
  2002.         HolderLine := '';
  2003.         StringIn := Copy( StringIn , Counter_1 + 1 , 255 );
  2004.         Result := ReturnString;
  2005.         exit;
  2006.       end
  2007.       else
  2008.       begin
  2009.         if StringIn[ Counter_1 ] <> #0 then
  2010.         begin
  2011.           if StringIn[ Counter_1 ] <> #13 then
  2012.            HolderLine := HolderLine + StringIn[ Counter_1 ];
  2013.         end
  2014.         else
  2015.         begin
  2016.           Result := '';
  2017.           StringIn := '';
  2018.         end;
  2019.       end;
  2020.     end;
  2021.   end;
  2022.   Result := '';
  2023.   StringIn := '';
  2024. end;
  2025.  
  2026. procedure TFTPComponent.GetFileNameFromUNIXFileName( var TheName : String );
  2027. var Counter_1 : Integer;
  2028.     ResultString : String;
  2029.     Finished : Boolean;
  2030. begin
  2031.   if Pos( 'TOTAL' , Uppercase( TheName )) <> 0 then
  2032.   begin
  2033.     TheName := '';
  2034.     exit;
  2035.   end;
  2036.   Counter_1 := Length( TheName );
  2037.   ResultString := '';
  2038.   Finished := false;
  2039.   while not Finished do
  2040.   begin
  2041.     if TheName[ Counter_1 ] <> ' ' then
  2042.     begin
  2043.       Counter_1 := Counter_1 - 1;
  2044.       if Counter_1 = 0 then
  2045.       begin
  2046.         ResultString := TheName;
  2047.         Finished := true;
  2048.       end;
  2049.     end
  2050.     else
  2051.     begin
  2052.       Finished := true;
  2053.       ResultString := Copy( TheName , Counter_1 + 1 , 255 );
  2054.     end;
  2055.   end;
  2056.   TheName := ResultString;
  2057. end;
  2058.  
  2059. { This is the FTP components get remote directory listing into a list box }
  2060. function TFTPComponent.GetRemoteDirectoryListing( TheListBox : TListBox )
  2061.           : Boolean;
  2062. var TheReturnString : String;  { Internal string holder }
  2063.     TheResult       : Integer; { Internal int holder    }
  2064.     InputString     : String;
  2065.     Through ,
  2066.     Finished        : Boolean;
  2067. begin
  2068.   TheListBox.Clear;
  2069.   TheListbox.Tag := 2;
  2070.   TheListBox.Items.Add('..');
  2071.   Result := true;
  2072.   TheReturnString :=
  2073.    DoCStyleFormat( 'TYPE A' ,
  2074.     [ nil ] );
  2075.   { Put result in progress and status line }
  2076.   AddProgressText( TheReturnString );
  2077.   ShowProgressText( TheReturnString );
  2078.   { Send Password sequence }
  2079.   TheResult := PerformFTPCommand( 'TYPE A',
  2080.                                   [ nil ] );
  2081.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  2082.   begin
  2083.     Result := true;
  2084.     FTPCommandInProgress := false;
  2085.     exit;
  2086.   end;
  2087.   repeat
  2088.     TheResult := GetFTPServerResponse( TheReturnString );
  2089.     { Put result in progress and status line }
  2090.     AddProgressText( TheReturnString );
  2091.     ShowProgressText( TheReturnString );
  2092.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  2093.   FTPCommandInProgress := false;
  2094.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  2095.   begin
  2096.     { Do clever C formatting trick }
  2097.     TheReturnString :=
  2098.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  2099.       [ nil ] );
  2100.     { Put result in progress and status line }
  2101.     AddProgressText( TheReturnString );
  2102.     ShowProgressErrorText( TheReturnString );
  2103.     { Signal error }
  2104.     Result := true;
  2105.     { leave }
  2106.     exit;
  2107.   end
  2108.   else
  2109.   begin
  2110.     { Set up socket 2 for listening }
  2111.     Socket2.AsynchMode := False;
  2112.     Socket2.NonAsynchTimeoutValue := 60;
  2113.     { do a listen and send command to server that this is receipt socket }
  2114.     if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
  2115.     begin
  2116.       Socket2.CCSockCancelListen;
  2117.       exit;
  2118.     end;
  2119.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  2120.     TheResult := PerformFTPCommand( 'LIST' , [nil] );
  2121.     GetFTPServerResponse( TheReturnString );
  2122.     AddProgressText( TheReturnString );
  2123.     ShowProgressText( TheReturnString );
  2124.     Socket1.NonAsynchTimeoutValue := 30;
  2125.     if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
  2126.        ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
  2127.     begin
  2128.       TheReturnString :=
  2129.        DoCStyleFormat( 'Could not obtain remote directory!' ,
  2130.         [ nil ] );
  2131.       { Put result in progress and status line }
  2132.       AddProgressText( TheReturnString );
  2133.       ShowProgressErrorText( TheReturnString );
  2134.       Socket2.CCSockCancelListen;
  2135.       Result := true;
  2136.       exit;
  2137.     end;
  2138.     Socket2.CCSockAccept;
  2139.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  2140.     begin
  2141.       TheReturnString :=
  2142.        DoCStyleFormat( 'Could not establish receive socket!' ,
  2143.         [ nil ] );
  2144.       { Put result in progress and status line }
  2145.       AddProgressText( TheReturnString );
  2146.       ShowProgressErrorText( TheReturnString );
  2147.       Result := true;
  2148.       exit;
  2149.     end;
  2150.     Through := false;
  2151.     repeat
  2152.       TheReturnString := Socket2.StringData;
  2153.       if Length( TheReturnString ) = 0 then Through := true;
  2154.       if Length( TheReturnString ) > 0 then
  2155.       begin
  2156.         finished := false;
  2157.         while not finished do
  2158.         begin
  2159.           InputString := GetUNIXTextString( TheReturnString );
  2160.           if InputString = '' then Finished := true else
  2161.           begin
  2162.             GetFileNameFromUNIXFileName( InputString);
  2163.             If InputString <> '' then
  2164.             TheListBox.Items.Add( InputString );
  2165.           end;
  2166.         end;
  2167.       end;
  2168.       if GlobalAbortedFlag then
  2169.       begin
  2170.         Socket1.OutOfBand := 'ABOR'+#13#10;
  2171.         repeat
  2172.           TheResult := GetFTPServerResponse( TheReturnString );
  2173.           { Put result in progress and status line }
  2174.           AddProgressText( TheReturnString );
  2175.           ShowProgressText( TheReturnString );
  2176.         until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  2177.         result := true;
  2178.         exit;
  2179.       end;
  2180.     until Through;
  2181.     GetFTPServerResponse( TheReturnString );
  2182.     AddProgressText( TheReturnString );
  2183.     ShowProgressText( TheReturnString );
  2184.     { cancel listening on second socket and close it }
  2185.     Socket2.CCSockCancelListen;
  2186.     Socket2.CCSockClose;
  2187.   end;
  2188.   FTPCommandInProgress := false;
  2189. end;
  2190.  
  2191. { This is the FTP components get remote directory listing into a list box }
  2192. function TFTPComponent.GetRemoteDirectoryListingToMemo : Boolean;
  2193. var TheReturnString : String;  { Internal string holder }
  2194.     TheResult       : Integer; { Internal int holder    }
  2195.     Through         : Boolean;
  2196. begin
  2197.   Result := true;
  2198.   TheReturnString :=
  2199.    DoCStyleFormat( 'TYPE A' ,
  2200.     [ nil ] );
  2201.   { Put result in progress and status line }
  2202.   AddProgressText( TheReturnString );
  2203.   ShowProgressText( TheReturnString );
  2204.   { Send Password sequence }
  2205.   TheResult := PerformFTPCommand( 'TYPE A',
  2206.                                   [ nil ] );
  2207.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  2208.   begin
  2209.     Result := true;
  2210.     FTPCommandInProgress := false;
  2211.     exit;
  2212.   end;
  2213.   repeat
  2214.     TheResult := GetFTPServerResponse( TheReturnString );
  2215.     { Put result in progress and status line }
  2216.     AddProgressText( TheReturnString );
  2217.     ShowProgressText( TheReturnString );
  2218.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  2219.   FTPCommandInProgress := false;
  2220.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  2221.   begin
  2222.     { Do clever C formatting trick }
  2223.     TheReturnString :=
  2224.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  2225.       [ nil ] );
  2226.     { Put result in progress and status line }
  2227.     AddProgressText( TheReturnString );
  2228.     ShowProgressErrorText( TheReturnString );
  2229.     { Signal error }
  2230.     Result := true;
  2231.     { leave }
  2232.     exit;
  2233.   end
  2234.   else
  2235.   begin
  2236.     { Set up socket 2 for listening }
  2237.     Socket2.AsynchMode := False;
  2238.     Socket2.NonAsynchTimeoutValue := 30;
  2239.     { do a listen and send command to server that this is receipt socket }
  2240.     if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
  2241.     begin
  2242.       Socket2.CCSockCancelListen;
  2243.       exit;
  2244.     end;
  2245.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  2246.     TheResult := PerformFTPCommand( 'LIST' , [nil] );
  2247.     GetFTPServerResponse( TheReturnString );
  2248.     AddProgressText( TheReturnString );
  2249.     ShowProgressText( TheReturnString );
  2250.     Socket1.NonAsynchTimeoutValue := 30;
  2251.     if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
  2252.        ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
  2253.     begin
  2254.       TheReturnString :=
  2255.        DoCStyleFormat( 'Could not obtain remote directory!' ,
  2256.         [ nil ] );
  2257.       { Put result in progress and status line }
  2258.       AddProgressText( TheReturnString );
  2259.       ShowProgressErrorText( TheReturnString );
  2260.       Socket2.CCSockCancelListen;
  2261.       Result := true;
  2262.       exit;
  2263.     end;
  2264.     Socket2.CCSockAccept;
  2265.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  2266.     begin
  2267.       TheReturnString :=
  2268.        DoCStyleFormat( 'Could not establish receive socket!' ,
  2269.         [ nil ] );
  2270.       { Put result in progress and status line }
  2271.       AddProgressText( TheReturnString );
  2272.       ShowProgressErrorText( TheReturnString );
  2273.       Result := true;
  2274.       exit;
  2275.     end;
  2276.     Through := false;
  2277.     repeat
  2278.       TheReturnString := Socket2.StringData;
  2279.       if Length( TheReturnString ) = 0 then Through := true;
  2280.       if Length( TheReturnString ) > 0 then
  2281.       begin
  2282.         { Put result in progress and status line }
  2283.         AddProgressText( TheReturnString );
  2284.         ShowProgressText( TheReturnString );
  2285.       end;
  2286.       if GlobalAbortedFlag then
  2287.       begin
  2288.         Socket1.OutOfBand := 'ABOR'+#13#10;
  2289.         repeat
  2290.           TheResult := GetFTPServerResponse( TheReturnString );
  2291.           { Put result in progress and status line }
  2292.           AddProgressText( TheReturnString );
  2293.           ShowProgressText( TheReturnString );
  2294.         until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  2295.         result := true;
  2296.         exit;
  2297.       end;
  2298.     until Through;
  2299.     GetFTPServerResponse( TheReturnString );
  2300.     AddProgressText( TheReturnString );
  2301.     ShowProgressText( TheReturnString );
  2302.     { cancel listening on second socket and close it }
  2303.     Socket2.CCSockCancelListen;
  2304.     Socket2.CCSockClose;
  2305.   end;
  2306. end;
  2307.  
  2308. { This is the FTP components get local directory listing into a list box }
  2309. function TFTPComponent.GetLocalDirectoryAndListing( var TheString : String;
  2310.                                                         TheListBox : TListBox )
  2311.           : Boolean;
  2312. var TheFLB : TFileListBox;
  2313. begin
  2314.   { Get the working directory }
  2315.   GetDir( 0 , TheString );
  2316.   { Clear incoming LB }
  2317.   TheListBox.Clear;
  2318.   TheListBox.Tag := 2;
  2319.   TheFLB := TFileListBox.Create( Application.MainForm );
  2320.   TheFLB.Visible := false;
  2321.   TheFLB.Parent := Application.MainForm;
  2322.   TheFLB.FileType := [ ftNormal , ftDirectory ];
  2323.   TheFLB.Directory := TheString;
  2324.   TheFLB.Update;
  2325.   TheListBox.Items.Assign( TheFLB.Items );
  2326.   TheFLB.Free;
  2327.   result := true;
  2328. end;
  2329.  
  2330. { This is a clever c-style formatting trick }
  2331. function TFTPComponent.DoCStyleFormat(
  2332.                 TheText      : string;
  2333.           const TheArguments : array of const ) : String;
  2334. begin
  2335.   Result := Format( TheText , TheArguments ) + #13#10;
  2336. end;
  2337.  
  2338. function TFTPComponent.GetQuotedString( TheString : String ) : String;
  2339. var TheIndex     : Integer; { Holder var }
  2340.     ResultString : String;  { ditto      }
  2341. begin
  2342.   { Find out if " present at all }
  2343.   TheIndex := Pos( '"' , TheString );
  2344.   If TheIndex = 0 then
  2345.   begin
  2346.     { If not, return null string and exit }
  2347.     Result := '';
  2348.     exit;
  2349.   end
  2350.   else
  2351.   begin
  2352.     { Get from first " to end of string in holder }
  2353.     ResultString := Copy( TheString , TheIndex + 1 , 255 );
  2354.     { Find position to second " }
  2355.     TheIndex := Pos( '"' , ResultString );
  2356.     { If no ending " then return whole string and leave }
  2357.     if TheIndex = 0 then
  2358.     begin
  2359.       Result := ResultString;
  2360.       exit;
  2361.     end
  2362.     else
  2363.     begin
  2364.       { Get internal text between quotes and exit }
  2365.       ResultString := Copy( ResultString , 1 , TheIndex - 1 );
  2366.       Result := ResultString;
  2367.     end;
  2368.   end;
  2369. end;
  2370.  
  2371. procedure TCCINetCCForm.UpdateGauge( BytesFinished , TotalToHandle : longint );
  2372. var
  2373.   Percentage : longint;
  2374. begin
  2375.   if BytesFinished > TotalToHandle then BytesFinished := TotalToHandle;
  2376.   if TotalToHandle = 0 then exit;
  2377.   Percentage := Trunc( 100.0 / ( TotalToHandle / BytesFinished ));
  2378.   Gauge1.Progress := Percentage;
  2379.   Panel1.Caption := '  Status: ' + IntToStr( BytesFinished ) +
  2380.    ' bytes ' + FileNameToXFer + ' (' + IntToStr( Percentage ) + '% Done)';
  2381. end;
  2382.  
  2383. procedure TCCINetCCForm.UpdateUUGauge( BytesFinished , TotalToHandle : longint );
  2384. var
  2385.   Percentage : longint;
  2386. begin
  2387.   if BytesFinished > TotalToHandle then BytesFinished := TotalToHandle;
  2388.   if TotalToHandle = 0 then exit;
  2389.   Percentage := Trunc( 100.0 / ( TotalToHandle / BytesFinished ));
  2390.   Gauge1.Progress := Percentage;
  2391.   Panel1.Caption := '  Status: ' + IntToStr( BytesFinished ) +
  2392.    ' bytes UUCode (' + IntToStr( Percentage ) + '% Done)';
  2393.   Panel1.Show;
  2394. end;
  2395.  
  2396. { This procedure actually attempts to connect to the internet at an ftp site }
  2397. function TCCINetCCForm.DoFTPConnection( PCRPointer : PConnectionsRecord ) : boolean;
  2398. var TheReturnString : String; { Display results of connection in status lines }
  2399. begin
  2400.   { Create the component }
  2401.   Result := false;
  2402.   { Do busy cursors }
  2403.   SetHGCursors;
  2404.   if not TheFTPComponent.EstablishConnection( PCRPointer ) then
  2405.   begin
  2406.     { Do saved cursors }
  2407.     TheFTPComponent.FTPCommandInProgress := false;
  2408.     TheFTPComponent.Connection_Established := false;
  2409.     SetNormalCursors;
  2410.     exit;
  2411.   end
  2412.   else
  2413.   begin { Connected; continue login process }
  2414.     if not TheFTPComponent.LoginUser( PCRPointer ) then
  2415.     begin
  2416.       { Do saved cursors }
  2417.       TheFTPComponent.FTPCommandInProgress := false;
  2418.       TheFTPComponent.Connection_Established := false;
  2419.       SetNormalCursors;
  2420.       exit;
  2421.     end;
  2422.     if not TheFTPComponent.SendPassword( PCRPointer ) then
  2423.     begin
  2424.       { Do saved cursors }
  2425.       TheFTPComponent.FTPCommandInProgress := false;
  2426.       TheFTPComponent.Connection_Established := false;
  2427.       SetNormalCursors;
  2428.       exit;
  2429.     end;
  2430.     if not TheFTPComponent.SetRemoteStartupDirectory( PCRPointer ) then
  2431.     begin
  2432.       { Do saved cursors }
  2433.       SetNormalCursors;
  2434.       TheFTPComponent.Connection_Established := false;
  2435.       TheFTPComponent.FTPCommandInProgress := false;
  2436.       exit;
  2437.     end;
  2438.     if not TheFTPComponent.GetRemoteWorkingDirectory( TheReturnString ) then
  2439.     begin
  2440.       { Do saved cursors }
  2441.       TheFTPComponent.Connection_Established := false;
  2442.       TheFTPComponent.FTPCommandInProgress := false;
  2443.       SetNormalCursors;
  2444.       exit;
  2445.     end;
  2446.     { Put up remote directory via PWD and strip quotes }
  2447.     Label4.Caption := TheFTPComponent.GetQuotedString( TheReturnString );
  2448.     { Get the listings of directories and exit OK }
  2449.     TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  2450.     TheFTPComponent.GetLocalDirectoryAndListing( TheReturnString ,
  2451.      Listbox2 );
  2452.     if Label5.Canvas.TextWidth( TheReturnString ) > Label5.Width then
  2453.      TheReturnString := TheFTPComponent.GetShortPathName( TheReturnString );
  2454.     Label5.Caption := TheReturnString;
  2455.     SetNormalCursors;
  2456.     Result := true;
  2457.     EnableFTPMenus;
  2458.     TheFTPComponent.FTPCommandInProgress := false;
  2459.     Panel1.Caption := '  Status : Connected to ' + PCRPointer^.CIPAddress;
  2460.   end;
  2461. end;
  2462.  
  2463. { This procedure actually attempts to connect to the internet at an nntp site }
  2464. function TCCINetCCForm.DoNNTPConnection( PCRPointer : PConnectionsRecord ) : boolean;
  2465. begin
  2466.   { Create the component }
  2467.   Result := false;
  2468.   { Do busy cursors }
  2469.   SetHGCursors;
  2470.   if not TheNNTPComponent.EstablishConnection( PCRPointer ) then
  2471.   begin
  2472.     { Do saved cursors }
  2473.     TheNNTPComponent.NNTPCommandInProgress := false;
  2474.     TheNNTPComponent.Connection_Established := false;
  2475.     SetNormalCursors;
  2476.     exit;
  2477.   end
  2478.   else
  2479.   begin { Connected; continue login process }
  2480.     SetNormalCursors;
  2481.     Result := true;
  2482.     EnableNNTPMenus;
  2483.     TheNNTPComponent.NNTPCommandInProgress := false;
  2484.     Panel1.Caption := '  Status : Connected to ' + PCRPointer^.CIPAddress;
  2485.   end;
  2486. end;
  2487.  
  2488. { This procedure actually attempts to disconnect to the internet at an ftp site}
  2489. procedure TCCINetCCForm.DoFTPDisconnect;
  2490. begin
  2491.   { Call QUIT command }
  2492.   TheFTPComponent.Disconnect;
  2493.   { Kill the socket }
  2494.   TheFTPComponent.Socket1.CCSockClose;
  2495. end;
  2496.  
  2497. { This procedure actually attempts to disconnect to the internet at an ftp site}
  2498. procedure TCCINetCCForm.DoNNTPDisconnect;
  2499. begin
  2500.   { Call QUIT command }
  2501.   TheNNTPComponent.Disconnect;
  2502.   { Kill the socket }
  2503.   TheNNTPComponent.Socket1.CCSockClose;
  2504. end;
  2505.  
  2506. { This procedure reads in the ini file and default path info }
  2507. procedure TCCINetCCForm.ReadIniData;
  2508. begin
  2509.   TheICCIniFile := TIniFile.Create( 'CCICC.INI' );
  2510.   MailPath := TheICCIniFile.ReadString( 'Paths','MailPath','C:\WINDOWS' );
  2511.   NewsPath := TheICCIniFile.ReadString( 'Paths','NewsPath','C:\WINDOWS' );
  2512.   FTPPath := TheICCIniFile.ReadString( 'Paths','FTPPath','C:\WINDOWS' );
  2513.   PasswordControlVector := TheICCIniFile.ReadInteger( 'Vectors','PWControl',2 );
  2514.   DefaultDownloadVector := TheICCIniFile.ReadInteger( 'Vectors','DefDL', 3 );
  2515.   TheAnonRedialVector := TheICCIniFile.ReadInteger( 'Vectors','AnonRD', 20 );
  2516.   NewsReadArticlePurgingVector := TheICCIniFile.ReadInteger( 'Vectors','NewsPurge', 1 );
  2517.   NewsPostQueueingVector := TheICCIniFile.ReadInteger( 'Vectors','NewsQueue', 1 );
  2518.   NewsReadArticleDisplayVector := TheICCIniFile.ReadInteger( 'Vectors','NewsRDisp', 1 );
  2519.   NewsUUMIMEVector := TheICCIniFile.ReadInteger( 'Vectors','NewsUUMIME', 2 );
  2520.   NewsInitialUpdateVector := TheICCIniFile.ReadInteger( 'Vectors','NewsInitUD', 1 );
  2521.   EMPasswordControlVector := TheICCIniFile.ReadInteger( 'Vectors','EMPWControl', 1 );
  2522.   EMRemoteDeletionVector  := TheICCIniFile.ReadInteger( 'Vectors','EMRemDel', 2 );
  2523.   EMChokeVector           := TheICCIniFile.ReadInteger( 'Vectors','EMChoke', 1 );
  2524.   EMDefaultDownloadVector := TheICCIniFile.ReadInteger( 'Vectors','EMInitUD', 1 );
  2525.   EMQueueVector           := TheICCIniFile.ReadInteger( 'Vectors','EMQueue', 1 );
  2526.   TheICCIniFile.Free;
  2527. end;
  2528.  
  2529. { This procedure writes out default path data to the ini file }
  2530. procedure TCCINetCCForm.WriteIniData;
  2531. begin
  2532.   TheICCIniFile := TIniFile.Create( 'CCICC.INI' );
  2533.   TheICCIniFile.WriteString( 'Paths','MailPath', MailPath );
  2534.   TheICCIniFile.WriteString( 'Paths','NewsPath', NewsPath );
  2535.   TheICCIniFile.WriteString( 'Paths','FTPPath', FTPPath );
  2536.   TheICCIniFile.WriteInteger( 'Vectors','PWControl', PasswordControlVector );
  2537.   TheICCIniFile.WriteInteger( 'Vectors','DefDL', DefaultDownloadVector );
  2538.   TheICCIniFile.WriteInteger( 'Vectors','AnonRD', TheAnonRedialVector );
  2539.   TheICCIniFile.WriteInteger( 'Vectors','NewsPurge',
  2540.    NewsReadArticlePurgingVector );
  2541.   TheICCIniFile.WriteInteger( 'Vectors','NewsQueue', NewsPostQueueingVector );
  2542.   TheICCIniFile.WriteInteger( 'Vectors','NewsRDisp',
  2543.    NewsReadArticleDisplayVector );
  2544.   TheICCIniFile.WriteInteger( 'Vectors','NewsUUMIME', NewsUUMIMEVector );
  2545.   TheICCIniFile.WriteInteger( 'Vectors','NewsInitUD', NewsInitialUpdateVector );
  2546.   TheICCIniFile.WriteInteger( 'Vectors','EMPWControl', EMPasswordControlVector );
  2547.   TheICCIniFile.WriteInteger( 'Vectors','EMRemDel', EMRemoteDeletionVector );
  2548.   TheICCIniFile.WriteInteger( 'Vectors','EMChoke', EMChokeVector );
  2549.   TheICCIniFile.WriteInteger( 'Vectors','EMInitUD', EMDefaultDownloadVector );
  2550.   TheICCIniFile.WriteInteger( 'Vectors','EMQueue', EMQueueVector );
  2551.   TheICCIniFile.Free;
  2552. end;
  2553.  
  2554. { Procedure to load the FTP Site list }
  2555. procedure TCCINetCCForm.LoadFTPSiteFile;
  2556. var TheTCRecord : PConnectionsRecord; { Generic TCR Pointer    }
  2557.     FTPSLName   : String;             { FTP Site List filename }
  2558.     Counter_1   : Integer;            { Loop counter           }
  2559. begin
  2560.   { Create the sites list list }
  2561.   TheFTPSiteList := TList.Create;
  2562.   { Set up the FTP sites list file name }
  2563.   FTPSLName := FTPPath + '\FTPSITES.TCR';
  2564.   { If the FTP Site List exists load it in }
  2565.   if FileExists( FTPSLName ) then
  2566.   begin
  2567.     { set up the file and open it }
  2568.     AssignFile( TheFTPSiteFile , FTPSLName );
  2569.     Reset( TheFTPSiteFile );
  2570.     { read in the records }
  2571.     for Counter_1 := 0 to FileSize( TheFTPSiteFile ) - 1 do
  2572.     begin
  2573.       { Create the TCRecord }
  2574.       New( TheTCRecord );
  2575.       { Read in the data record }
  2576.       Seek( TheFTPSiteFile , Counter_1 );
  2577.       Read( TheFTPSiteFile , TheTCRecord^ );
  2578.       { Add the record to the list }
  2579.       TheFTPSiteList.Add( TheTCRecord );
  2580.     end;
  2581.     { close the file }
  2582.     CloseFile( TheFTPSiteFile );
  2583.   end
  2584.   else
  2585.   { Otherwise create a default one with a few anonymous sites }
  2586.   begin
  2587.     { create new record }
  2588.     New( TheTCRecord );
  2589.     { fill in its info }
  2590.     with TheTCRecord^ do
  2591.     begin
  2592.       CProfile   := 'Winsite Windows Archive';
  2593.       CIPAddress := 'ftp.winsite.com';
  2594.       CUserName  := 'anonymous';
  2595.       CPassword  := 'guest@nowhere.com';
  2596.       CStartDir  := '/pub';
  2597.     end;
  2598.     { add it to the list }
  2599.     { do it three more times }
  2600.     TheFTPSiteList.Add( TheTCRecord );
  2601.     New( TheTCRecord );
  2602.     with TheTCRecord^ do
  2603.     begin
  2604.       CProfile   := 'Digital Equipment Corp';
  2605.       CIPAddress := 'gatekeeper.dec.com';
  2606.       CUserName  := 'anonymous';
  2607.       CPassword  := 'guest@nowhere.com';
  2608.       CStartDir  := '/pub';
  2609.     end;
  2610.     TheFTPSiteList.Add( TheTCRecord );
  2611.     New( TheTCRecord );
  2612.     with TheTCRecord^ do
  2613.     begin
  2614.       CProfile   := 'Microsoft FTP Site';
  2615.       CIPAddress := 'ftp.microsoft.com';
  2616.       CUserName  := 'anonymous';
  2617.       CPassword  := 'guest@nowhere.com';
  2618.       CStartDir  := '/pub';
  2619.     end;
  2620.     TheFTPSiteList.Add( TheTCRecord );
  2621.     New( TheTCRecord );
  2622.     with TheTCRecord^ do
  2623.     begin
  2624.       CProfile   := 'Oakland MSDOS Archive';
  2625.       CIPAddress := 'oak.oakland.edu';
  2626.       CUserName  := 'anonymous';
  2627.       CPassword  := 'guest@nowhere.com';
  2628.       CStartDir  := '/pub';
  2629.     end;
  2630.     TheFTPSiteList.Add( TheTCRecord );
  2631.     { create the file and write out the data, then close it }
  2632.     AssignFile( TheFTPSiteFile , FTPSLName );
  2633.     Rewrite( TheFTPSiteFile );
  2634.     for Counter_1 := 0 to 3 do
  2635.     begin
  2636.       TheTCRecord :=
  2637.        PConnectionsRecord( TheFTPSiteList.Items[ Counter_1 ] );
  2638.       Seek( TheFTPSiteFile , Counter_1 );
  2639.       Write( TheFTPSiteFile , TheTCRecord^ );
  2640.     end;
  2641.     CloseFile( TheFTPSiteFile );
  2642.   end;
  2643.   { Create the working copy for use to make safe changes in info dlg }
  2644.   TheWorkingFTPSL := TList.Create;
  2645.   For Counter_1 := 0 to TheFTPSiteList.Count - 1 do
  2646.   begin
  2647.     New( TheTCRecord );
  2648.     TheTCRecord^ := PConnectionsRecord( TheFTPSiteList.Items[ Counter_1 ] )^;
  2649.     TheWorkingFTPSL.Add( TheTCRecord );
  2650.   end;
  2651. end;
  2652.  
  2653. { Procedure to load the NNTP Site list }
  2654. procedure TCCINetCCForm.LoadNNTPSiteFile;
  2655. var TheNGRecord : PConnectionsRecord; { Generic TCR Pointer    }
  2656.     NNTPSLName  : String;             { NNTP Site List filename }
  2657.     Counter_1   : Integer;            { Loop counter           }
  2658. begin
  2659.   { Create the sites list list }
  2660.   TheNewsServerList := TList.Create;
  2661.   { Set up the FTP sites list file name }
  2662.   NNTPSLName := NewsPath + '\NNTPSITE.TCR';
  2663.   { If the FTP Site List exists load it in }
  2664.   if FileExists( NNTPSLName ) then
  2665.   begin
  2666.     { set up the file and open it }
  2667.     AssignFile( TheNewsServerFile , NNTPSLName );
  2668.     Reset( TheNewsServerFile );
  2669.     { read in the records }
  2670.     for Counter_1 := 0 to FileSize( TheNewsServerFile ) - 1 do
  2671.     begin
  2672.       { Create the TCRecord }
  2673.       New( TheNGRecord );
  2674.       { Read in the data record }
  2675.       Seek( TheNewsServerFile , Counter_1 );
  2676.       Read( TheNewsServerFile , TheNGRecord^ );
  2677.       { Add the record to the list }
  2678.       TheNewsServerList.Add( TheNGRecord );
  2679.     end;
  2680.     { close the file }
  2681.     CloseFile( TheNewsServerFile );
  2682.   end
  2683.   else
  2684.   { Otherwise create a default one with a generic news site (?) }
  2685.   begin
  2686.     { create new record }
  2687.     New( TheNGRecord );
  2688.     { fill in its info }
  2689.     with TheNGRecord^ do
  2690.     begin
  2691.       CProfile   := 'My News Server';
  2692.       CIPAddress := 'news.myprovider.com';
  2693.       CUserName  := '';
  2694.       CPassword  := '';
  2695.       CStartDir  := '';
  2696.     end;
  2697.     { add it to the list }
  2698.     { do it three more times }
  2699.     TheNewsServerList.Add( TheNGRecord );
  2700.     { create the file and write out the data, then close it }
  2701.     AssignFile( TheNewsServerFile , NNTPSLName );
  2702.     Rewrite( TheNewsServerFile );
  2703.     TheNGRecord :=
  2704.        PConnectionsRecord( TheNewsServerList.Items[ 0 ] );
  2705.       Seek( TheNewsServerFile , 0 );
  2706.       Write( TheNewsServerFile , TheNGRecord^ );
  2707.     CloseFile( TheNewsServerFile );
  2708.   end;
  2709.   TheWorkingNSSL := TList.Create;
  2710.   For Counter_1 := 0 to TheNewsServerList.Count - 1 do
  2711.   begin
  2712.     New( TheNGRecord );
  2713.     TheNGRecord^ := PConnectionsRecord( TheNewsServerList.Items[ Counter_1 ] )^;
  2714.     TheWorkingNSSL.Add( TheNGRecord );
  2715.   end;
  2716. end;
  2717.  
  2718. { This procedure saves off the FTP Site List }
  2719. procedure TCCINetCCForm.SaveFTPSiteFile;
  2720. var TheTCRecord : PConnectionsRecord; { The TC Record pointer  }
  2721.     FTPSLName   : String;             { FTP Site List filename }
  2722.     Counter_1   : Integer;            { Loop counter           }
  2723. begin
  2724.   { Set up the file name }
  2725.   FTPSLName := FTPPath + '\FTPSITES.TCR';
  2726.   { Assign the file }
  2727.   AssignFile( TheFTPSiteFile , FTPSLName );
  2728.   { Rewrite it }
  2729.   Rewrite( TheFTPSiteFile );
  2730.   { run the list through the procedure }
  2731.   for Counter_1 := 0 to TheFTPSiteList.Count - 1 do
  2732.   begin
  2733.     { get the record from the list }
  2734.     TheTCRecord :=
  2735.      PConnectionsRecord( TheFTPSiteList.Items[ Counter_1 ] );
  2736.     { Do the seek/write }
  2737.     Seek( TheFTPSiteFile , Counter_1 );
  2738.     Write( TheFTPSiteFile , TheTCRecord^ );
  2739.     { free the record }
  2740.     Dispose( TheTCRecord );
  2741.   end;
  2742.   { Close the file }
  2743.   CloseFile( TheFTPSiteFile );
  2744.   { Free the list pointers }
  2745.   TheFTPSiteList.Free;
  2746.   TheWorkingFTPSL.Free;
  2747. end;
  2748.  
  2749. { This procedure saves off the FTP Site List }
  2750. procedure TCCINetCCForm.SaveNNTPSiteFile;
  2751. var TheNGRecord : PConnectionsRecord; { The TC Record pointer   }
  2752.     NNTPSLName   : String;            { NNTP Site List filename }
  2753.     Counter_1   : Integer;            { Loop counter           }
  2754. begin
  2755.   { Set up the file name }
  2756.   NNTPSLName := NewsPath + '\NNTPSITE.TCR';
  2757.   { Assign the file }
  2758.   AssignFile( TheNewsServerFile , NNTPSLName );
  2759.   { Rewrite it }
  2760.   Rewrite( TheNewsServerFile );
  2761.   { run the list through the procedure }
  2762.   for Counter_1 := 0 to TheNewsServerList.Count - 1 do
  2763.   begin
  2764.     { get the record from the list }
  2765.     TheNGRecord :=
  2766.      PConnectionsRecord( TheNewsServerList.Items[ Counter_1 ] );
  2767.     { Do the seek/write }
  2768.     Seek( TheNewsServerFile , Counter_1 );
  2769.     Write( TheNewsServerFile , TheNGRecord^ );
  2770.     { free the record }
  2771.     Dispose( TheNGRecord );
  2772.   end;
  2773.   { Close the file }
  2774.   CloseFile( TheNewsServerFile );
  2775.   { Free the list pointers }
  2776.   TheNewsServerList.Free;
  2777.   TheWorkingNSSL.Free;
  2778. end;
  2779.  
  2780. { This procedure switches in the FTP sites list to the info dlg and main cbox }
  2781. procedure TCCINetCCForm.SetupFTPSiteLists;
  2782. var Counter_1  : Integer;            { Loop counter        }
  2783. begin
  2784.   { Set up display for main form }
  2785.   CCINetCCForm.Tag := 2;
  2786.   CCINetCCForm.Caption := 'CC Internet Command Center -- FTP Mode';
  2787.   CCINetCCForm.ViewWinsockInfo1.Enabled := false;
  2788.   CCINetCCForm.FTP1.Enabled := false;
  2789.   CCINetCCForm.FTP2.Enabled := true;
  2790.   CCINetCCForm.Label1.Caption := 'FTP Site:';
  2791.   CCINetCCForm.Button1.Caption := 'Connect';
  2792.   CCINetCCForm.Label4.Caption := 'Local Dir';
  2793.   CCINetCCForm.Label5.Caption := 'Remote Dir';
  2794.   { Set tag for FTP stuff }
  2795.   CCICInfoDlg.Tag := 2;
  2796.   { set up caption of main label }
  2797.   CCICInfoDlg.Label2.Caption := 'FTP Sites';
  2798.   { hide outline panel }
  2799.   CCICInfoDlg.Panel6.Visible := false;
  2800.   { clear the list box }
  2801.   CCICInfoDlg.ListBox2.Clear;
  2802.   CCINetCCForm.ComboBox1.Clear;
  2803.   { add profile strings to the list box }
  2804.   for Counter_1 := 0 to TheFTPSiteList.Count - 1 do
  2805.   begin
  2806.     CCICInfoDlg.ListBox2.Items.Add( PConnectionsRecord(
  2807.      TheFTPSiteList.Items[ Counter_1 ] )^.CProfile );
  2808.     CCINetCCForm.ComboBox1.Items.Add( PConnectionsRecord(
  2809.      TheFTPSiteList.Items[ Counter_1 ] )^.CProfile );
  2810.   end;
  2811.   { Set up caption of special button }
  2812.   CCICInfoDlg.Button1.Caption := 'Anonymous Login';
  2813.   { Start with top record }
  2814.   CCICInfoDlg.ListBox2.ItemIndex := 0;
  2815.   CCINetCCForm.ComboBox1.ItemIndex := 0;
  2816.   { put in data from top record and reset captions }
  2817.   with PConnectionsRecord( TheFTPSiteList.Items[ 0 ] )^ do
  2818.   begin
  2819.     with CCICInfoDlg do
  2820.     begin
  2821.       Edit1.Text := CProfile;
  2822.       Panel2.Caption := '            Name:';
  2823.       Edit2.Text := CIPAddress;
  2824.       Panel3.Caption := '     IP Address:';
  2825.       Edit3.Text := CUserName;
  2826.       Panel5.Caption := '    User Name:';
  2827.       case PasswordControlVector of
  2828.         1 : Edit4.Text := CPassword;
  2829.         2 : Edit4.Text := '**********';
  2830.       end;
  2831.       Panel8.Caption := '      Password:';
  2832.       Edit5.Text := CStartDir;
  2833.       Panel9.Caption := '    Starting Dir:';
  2834.     end;
  2835.   end;
  2836. end;
  2837.  
  2838. { This procedure switches in the FTP sites list to the info dlg and main cbox }
  2839. procedure TCCINetCCForm.SetupNNTPSiteLists;
  2840. begin
  2841.   { Set up display for main form }
  2842.   CCINetCCForm.Tag := 4; { Usenet News Tag }
  2843.   CCINetCCForm.Caption := 'CC Internet Command Center -- Usenet News Mode';
  2844.   CCINetCCForm.ViewWinsockInfo1.Enabled := false;
  2845.   CCINetCCForm.FTP1.Enabled := true;
  2846.   CCINetCCForm.FTP2.Enabled := false;
  2847.   CCINetCCForm.UsenetNws1.Enabled := false;
  2848.   CCINetCCForm.News1.Enabled := true;
  2849.   CCINetCCForm.Label1.Caption := 'NNTP Server:';
  2850.   CCINetCCForm.Button1.Caption := 'Connect';
  2851.   CCINetCCForm.Label4.Caption := 'SubScribed Groups';
  2852.   CCINetCCForm.Label5.Caption := 'Unread Articles';
  2853.   { Create the working copy for use to make safe changes in info dlg }
  2854. end;
  2855.  
  2856. { This method saves off the Newsgroup and Article Lists }
  2857. procedure TCCINetCCForm.SaveNNTPNewsGroupLists;
  2858. var TheNGRecord : PNewsGroupRecord; { Generic NGR Pointer       }
  2859.     TheNGARecord : PNewsGroupArticleRecord; {  }
  2860.     WorkingList : TList;
  2861.     Counter_1 ,
  2862.     Counter_2   : Integer;          { Loop counter              }
  2863.     NNTPNGLName ,                   { NewsGroup Articles fname  }
  2864.     NNTPARName  : String;           { NNTP NewsRC filename      }
  2865. begin
  2866.   { Abort if no server to select }
  2867.   if ComboBox1.ItemIndex = -1 then exit;
  2868.   { Get number of server in list }
  2869.   WhichServer := ComboBox1.ItemIndex;
  2870.   { Set up the FTP sites list file name }
  2871.   NNTPNGLName := NewsPath + '\NEWSRC ' + IntToStr( WhichServer ) + '.NRC';
  2872.   { If the FTP Site List exists load it in }
  2873.   { set up the file and open it }
  2874.   AssignFile( TheNewsRCFile , NNTPNGLName );
  2875.   ReWrite( TheNewsRCFile );
  2876.   { read in the records }
  2877.   for Counter_1 := 0 to TheNewsRCList.Count - 1 do
  2878.   begin
  2879.     { Create the TCRecord }
  2880.     TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] );
  2881.     { Read in the data record }
  2882.     Seek( TheNewsRCFile , Counter_1 );
  2883.     Write( TheNewsRCFile , TheNGRecord^ );
  2884.     { Add the record to the list }
  2885.     WorkingList := TList( TheNGRecord^.GLTag );
  2886.     if WorkingList.Count > 0 then
  2887.     begin
  2888.       NNTPARName := TheNGRecord^.GFileName;
  2889.       TheNGArticlesList := TList.Create;
  2890.       AssignFile( TheNewsArticleFile , NewsPath + '\' + NNTPARName );
  2891.       ReWrite( TheNewsArticleFile );
  2892.       for Counter_2 := 0 to WorkingList.Count - 1 do
  2893.       begin
  2894.         TheNGARecord :=
  2895.          PNewsGroupArticleRecord( WorkingList.Items[ Counter_2 ] );
  2896.         Seek( TheNewsArticleFile , Counter_2 );
  2897.         Write( TheNewsArticleFile , TheNGARecord^ );
  2898.         Dispose( TheNGARecord );
  2899.       end;
  2900.       CloseFile( TheNewsArticleFile );
  2901.     end;
  2902.     WorkingList.Free;
  2903.     Dispose( TheNGRecord );
  2904.   end;
  2905.   { close the file }
  2906.   CloseFile( TheNewsRCFile );
  2907.   { Free the list itself }
  2908.   TheNewsRCList.Free;
  2909. end;
  2910.  
  2911. { This procedure switches in the FTP sites list to the info dlg and main cbox }
  2912. procedure TCCINetCCForm.SetupNNTPNewsGroupLists;
  2913. var TheNGRecord : PNewsGroupRecord; { Generic NGR Pointer       }
  2914.     TheNGARecord : PNewsGroupArticleRecord; {  }
  2915.     Counter_1 ,
  2916.     Counter_2   : Integer;          { Loop counter              }
  2917.     NNTPNGLName ,                   { NewsGroup Articles fname  }
  2918.     NNTPARName  : String;           { NNTP NewsRC filename      }
  2919. begin
  2920.   { Abort if no server to select }
  2921.   if ComboBox1.ItemIndex = -1 then exit;
  2922.   { Get number of server in list }
  2923.   WhichServer := ComboBox1.ItemIndex;
  2924.   { Create the sites list list }
  2925.   TheNewsRCList := TList.Create;
  2926.   { Set up the FTP sites list file name }
  2927.   NNTPNGLName := NewsPath + '\NEWSRC ' + IntToStr( WhichServer ) + '.NRC';
  2928.   { If the FTP Site List exists load it in }
  2929.   if FileExists( NNTPNGLName ) then
  2930.   begin
  2931.     { set up the file and open it }
  2932.     AssignFile( TheNewsRCFile , NNTPNGLName );
  2933.     Reset( TheNewsRCFile );
  2934.     { read in the records }
  2935.     for Counter_1 := 0 to FileSize( TheNewsRCFile ) - 1 do
  2936.     begin
  2937.       { Create the TCRecord }
  2938.       New( TheNGRecord );
  2939.       { Read in the data record }
  2940.       Seek( TheNewsRCFile , Counter_1 );
  2941.       Read( TheNewsRCFile , TheNGRecord^ );
  2942.       { Add the record to the list }
  2943.       TheNewsRCList.Add( TheNGRecord );
  2944.     end;
  2945.     { close the file }
  2946.     CloseFile( TheNewsRCFile );
  2947.   end
  2948.   else
  2949.   { Otherwise create a default one with 3 delphi newsgroups }
  2950.   begin
  2951.     { create new record }
  2952.     New( TheNGRecord );
  2953.     { fill in its info }
  2954.     with TheNGRecord^ do
  2955.     begin
  2956.       GName                := 'Delphi Comps';
  2957.       GRealName            := 'comp.lang.pascal.delphi.components';
  2958.       GLowest              := 0;
  2959.       GHighest             := 0;
  2960.       GPostable            := true;
  2961.       GSubscribed          := true;
  2962.       GTotalArticles       := 0;
  2963.       GTotalAvailable      := 0;
  2964.       GLowestAvailable     := 0;
  2965.       GHighestAvailable    := 0;
  2966.       GTotalUnReadArticles := 0;
  2967.       GIDNumber            := 1;
  2968.       GFileName            := 'NL' + IntToStr( WhichServer ) + 'G1.NGR';
  2969.       GLTag                := 0;
  2970.     end;
  2971.     { add it to the list }
  2972.     TheNewsRCList.Add( TheNGRecord );
  2973.     { create new record }
  2974.     New( TheNGRecord );
  2975.     { fill in its info }
  2976.     with TheNGRecord^ do
  2977.     begin
  2978.       GName                := 'Delphi DB';
  2979.       GRealName            := 'comp.lang.pascal.delphi.databases';
  2980.       GLowest              := 0;
  2981.       GHighest             := 0;
  2982.       GPostable            := true;
  2983.       GSubscribed          := true;
  2984.       GTotalArticles       := 0;
  2985.       GTotalAvailable      := 0;
  2986.       GLowestAvailable     := 0;
  2987.       GHighestAvailable    := 0;
  2988.       GTotalUnReadArticles := 0;
  2989.       GIDNumber            := 2;
  2990.       GFileName            := 'NL' + IntToStr( WhichServer ) + 'G2.NGR';
  2991.       GLTag                := 0;
  2992.     end;
  2993.     { add it to the list }
  2994.     TheNewsRCList.Add( TheNGRecord );
  2995.     { create new record }
  2996.     New( TheNGRecord );
  2997.     { fill in its info }
  2998.     with TheNGRecord^ do
  2999.     begin
  3000.       GName                := 'Delphi Misc';
  3001.       GRealName            := 'comp.lang.pascal.delphi.misc';
  3002.       GLowest              := 0;
  3003.       GHighest             := 0;
  3004.       GPostable            := true;
  3005.       GSubscribed          := true;
  3006.       GTotalArticles       := 0;
  3007.       GTotalAvailable      := 0;
  3008.       GLowestAvailable     := 0;
  3009.       GHighestAvailable    := 0;
  3010.       GTotalUnReadArticles := 0;
  3011.       GIDNumber            := 3;
  3012.       GFileName            := 'NL' + IntToStr( WhichServer ) + 'G3.NGR';
  3013.       GLTag                := 0;
  3014.     end;
  3015.     { add it to the list }
  3016.     TheNewsRCList.Add( TheNGRecord );
  3017.     { create the file and write out the data, then close it }
  3018.     AssignFile( TheNewsRCFile , NNTPNGLName );
  3019.     Rewrite( TheNewsRCFile );
  3020.     for Counter_1 := 0 to 2 do
  3021.     begin
  3022.       TheNGRecord :=
  3023.        PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] );
  3024.       Seek( TheNewsRCFile , Counter_1 );
  3025.       Write( TheNewsRCFile , TheNGRecord^ );
  3026.     end;
  3027.     CloseFile( TheNewsRCFile );
  3028.   end;
  3029.   { Load in Articles Records and create storage lists }
  3030.   for Counter_1 := 0 to TheNewsRCList.Count - 1 do
  3031.   begin
  3032.     NNTPARName := PNewsGroupRecord(
  3033.      TheNewsRCList.Items[ Counter_1 ] )^.GFileName;
  3034.     if FileExists( NewsPath + '\' + NNTPARName ) then
  3035.     begin
  3036.       TheNGArticlesList := TList.Create;
  3037.       AssignFile( TheNewsArticleFile , NewsPath + '\' + NNTPARName );
  3038.       Reset( TheNewsArticleFile );
  3039.       for Counter_2 := 0 to FileSize( TheNewsArticleFile ) - 1 do
  3040.       begin
  3041.         New( TheNGARecord );
  3042.         Seek( TheNewsArticleFile , Counter_2 );
  3043.         Read( TheNewsArticleFile , TheNGARecord^ );
  3044.         TheNGArticlesList.Add( TheNGARecord );
  3045.       end;
  3046.       CloseFile( TheNewsArticleFile );
  3047.       PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] )^.GLTag :=
  3048.        Longint( TheNGArticlesList );
  3049.     end
  3050.     else
  3051.     begin
  3052.       TheNGArticlesList := TList.Create;
  3053.       PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] )^.GLTag :=
  3054.        Longint( TheNGArticlesList );
  3055.     end;
  3056.   end;
  3057.   { Create working Newsgroup list for later }
  3058.   TheWorkingNRCSL := TList.Create;
  3059.   For Counter_1 := 0 to TheNewsRCList.Count - 1 do
  3060.   begin
  3061.     New( TheNGRecord );
  3062.     TheNGRecord^ := PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] )^;
  3063.     TheWorkingNRCSL.Add( TheNGRecord );
  3064.   end;
  3065. end;
  3066.  
  3067. { This procedure populates LB2 with article subjects for any }
  3068. { available articles for a given newsgroup.                  }
  3069. procedure TCCINetCCForm.PopulateLB2WithArticleHeaders;
  3070. var Counter_1    : Integer;
  3071.     TheNGARecord : PNewsGroupArticleRecord;
  3072.     TempString   : String;
  3073. begin
  3074.   { Clear target list box }
  3075.   ListBox2.Clear;
  3076.   for Counter_1 := 0 to TheNGArticlesList.Count - 1 do
  3077.   begin
  3078.     TheNGARecord :=
  3079.      PNewsGroupArticleRecord( TheNGArticlesList.Items[ Counter_1 ] );
  3080.     TempString := '    [' + IntToStr( Counter_1 ) + '] ' +
  3081.      TheNGARecord^.NGASubject;
  3082.     if TheNGARecord^.NGADownloaded then TempString[ 1 ] :=
  3083.      'D';
  3084.     if TheNGARecord^.NGARead then TempString[ 3 ] := 'R';
  3085.     if TheNGARecord^.NGAPosted then TempString[ 3 ] := 'S';
  3086.     ListBox2.Items.Add( TempString );
  3087.   end;
  3088. end;
  3089.  
  3090. { This procedure swaps in the list of subscribed newsgroups to LB1 }
  3091. { and calls another procedure to populate LB2 with any available   }
  3092. { articles for the newsgroup.                                      }
  3093. procedure TCCINetCCForm.SetupNewsGroupListboxes;
  3094. var Counter_1   : Integer;
  3095.     TempString  : String;
  3096.     TheNGRecord : PNewsGroupRecord;
  3097. begin
  3098.   ListBox1.Clear;
  3099.   ListBox1.Tag := 5;
  3100.   ListBox2.Tag := 5;
  3101.   Label4.Caption := 'NewsGroups';
  3102.   Label5.Caption := 'Articles';
  3103.   if TheNewsRCList.Count = 0 then
  3104.   begin
  3105.     ListBox2.Clear;
  3106.     exit;
  3107.   end;
  3108.   ComboBox1.Clear;
  3109.   for Counter_1 := 0 to TheNewsRCList.Count - 1 do
  3110.   begin
  3111.     TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] );
  3112.     TempString := TheNGRecord^.GName;
  3113.     ComboBox1.Items.Add( TheNGRecord^.GRealName );
  3114.     if TheNGRecord^.GSubscribed then
  3115.      TempString := '[S] ' + TempString else TempString := '[U] ' + TempString;
  3116.     TempString := TempString + '{' + IntToStr( TheNGRecord^.GTotalNew ) + '}';
  3117.     ListBox1.Items.Add( TempString );
  3118.   end;
  3119.   TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ 0 ] );
  3120.   TheNGArticlesList := TList( TheNGRecord^.GLTag );
  3121.   PopulateLB2WithArticleHeaders;
  3122.   Label1.Caption := 'NewsGroup:';
  3123.   ComboBox1.ItemIndex := 0;
  3124.   Button1.Caption := 'DL Article(s)';
  3125.   Tag := 5; { Set download vector }
  3126. end;
  3127.  
  3128. { This procedure switches in the FTP sites list to the info dlg and main cbox }
  3129. procedure TCCINetCCForm.SetupNNTPServersInfoDisplay;
  3130. var Counter_1  : Integer;            { Loop counter        }
  3131. begin
  3132.   { Set tag for NNTP stuff }
  3133.   CCICInfoDlg.Tag := 4; { Usenet News Tag -- servers }
  3134.   { set up caption of main label }
  3135.   CCICInfoDlg.Label2.Caption := 'News Server Sites';
  3136.   { hide outline panel }
  3137.   CCICInfoDlg.Panel6.Visible := false;
  3138.   CCICInfoDlg.Panel5.Visible := false;
  3139.   CCICInfoDlg.Panel8.Visible := false;
  3140.   CCICInfoDlg.Panel9.Visible := false;
  3141.   { clear the list box }
  3142.   CCICInfoDlg.ListBox2.Clear;
  3143.   CCINetCCForm.ComboBox1.Clear;
  3144.   { add profile strings to the list box }
  3145.   for Counter_1 := 0 to TheNewsServerList.Count - 1 do
  3146.   begin
  3147.     CCICInfoDlg.ListBox2.Items.Add( PConnectionsRecord(
  3148.      TheNewsServerList.Items[ Counter_1 ] )^.CProfile );
  3149.     CCINetCCForm.ComboBox1.Items.Add( PConnectionsRecord(
  3150.      TheNewsServerList.Items[ Counter_1 ] )^.CProfile );
  3151.   end;
  3152.   { Set up caption of special button }
  3153.   CCICInfoDlg.Button1.Visible := false;
  3154.   { Start with top record }
  3155.   CCICInfoDlg.ListBox2.ItemIndex := 0;
  3156.   CCINetCCForm.ComboBox1.ItemIndex := 0;
  3157.   { put in data from top record and reset captions }
  3158.   with PConnectionsRecord( TheNewsServerList.Items[ 0 ] )^ do
  3159.   begin
  3160.     with CCICInfoDlg do
  3161.     begin
  3162.       Edit1.Text := CProfile;
  3163.       Panel2.Caption := '            Name:';
  3164.       Edit2.Text := CIPAddress;
  3165.       Panel3.Caption := '     IP Address:';
  3166.     end;
  3167.   end;
  3168. end;
  3169.  
  3170. { This procedure switches in the FTP sites list to the info dlg and main cbox }
  3171. procedure TCCINetCCForm.SetupNNTPNewsGroupsInfoDisplay;
  3172. var Counter_1  : Integer;            { Loop counter        }
  3173.     WorkingFileName : String;
  3174.     TheWorkingSL : TStringList;
  3175. begin
  3176.   { Set tag for NNTP stuff }
  3177.   CCICInfoDlg.Tag := 5; { Usenet News Tag -- newsgroups }
  3178.   { set up caption of main label }
  3179.   CCICInfoDlg.Label2.Caption := 'Active NewsGroups';
  3180.   { hide outline panel }
  3181.   CCICInfoDlg.Panel5.Visible := true;
  3182.   CCICInfoDlg.Panel6.Visible := true;
  3183.   CCICInfoDlg.Panel6.Height := 224;
  3184.   CCICInfoDlg.Panel6.Top := 120;
  3185.   CCICInfoDlg.Label1.Caption := 'Available NewsGroups';
  3186.   CCICInfoDlg.Panel8.Visible := false;
  3187.   CCICInfoDlg.Panel9.Visible := false;
  3188.   { clear the list box }
  3189.   CCICInfoDlg.ListBox2.Clear;
  3190.   { add profile strings to the list box }
  3191.   for Counter_1 := 0 to TheNewsRCList.Count - 1 do
  3192.   begin
  3193.     CCICInfoDlg.ListBox2.Items.Add( PNewsGroupRecord(
  3194.      TheNewsRCList.Items[ Counter_1 ] )^.GName );
  3195.   end;
  3196.   { Set up caption of special button }
  3197.   CCICInfoDlg.Button1.Visible := true;
  3198.   CCICInfoDlg.Button1.Caption := 'Toggle Subscription';
  3199.   { Start with top record }
  3200.   CCICInfoDlg.ListBox2.ItemIndex := 0;
  3201.   { put in data from top record and reset captions }
  3202.   with PNewsGroupRecord( TheNewsRCList.Items[ 0 ] )^ do
  3203.   begin
  3204.     with CCICInfoDlg do
  3205.     begin
  3206.       Edit1.Text := GName;
  3207.       Panel2.Caption := 'NG Name:';
  3208.       Edit2.Text := GRealName;
  3209.       Panel3.Caption := 'NG Real Name:';
  3210.       if GSubscribed then
  3211.       Edit3.Text := 'Subscribed' else Edit3.Text := 'UnSubscribed';
  3212.       Panel5.Caption := 'Status:';
  3213.     end;
  3214.   end;
  3215.   if newsgroupListloaded then exit;
  3216.   WorkingFileName := NewsPath + '\NEWSGRP.TXT';
  3217.   if FileExists( WorkingFileName ) then
  3218.   begin
  3219.     if MessageDlg( 'Load News Groups File? (Long operation...)',
  3220.      mtConfirmation,mbYesNoCancel,0) = mrYes then
  3221.     begin
  3222.       CCICInfoDlg.ListBox1.Clear;
  3223.       TheWorkingSL := TStringList.Create;
  3224.       try
  3225.         TheWorkingSL.LoadFromFile( WorkingFileName );
  3226.         CCICInfoDlg.ListBox1.Items.Assign( TheWorkingSL );
  3227.       except
  3228.         MessageDlg( 'News Group List Too Large! Use WordPad/Write to view ' +
  3229.                       NewsPath + '\NEWGRP.TXT' , mtInformation,[mbOK],0);
  3230.         TheWorkingSL.Free;
  3231.         NewsgroupListLoaded := false;
  3232.         exit;
  3233.       end;
  3234.       TheWorkingSL.Free;
  3235.       NewsgroupListLoaded := true;
  3236.     end;
  3237.   end;
  3238. end;
  3239.  
  3240. { This procedure scans a line of UNIX-style text for #10's and }
  3241. { outputs them as lines to the memo. It stops at #0.           }
  3242. procedure TCCINetCCForm.AddNullTermTextToMemo( TheTextToAdd   : String;
  3243.                                  TheMemoToAddTo : TMemo   );
  3244. var
  3245.   TextLength ,            { Total chars to output         }
  3246.   Counter_1    : integer; { Loop Index                    }
  3247. begin
  3248.   { Make the target memo visible just in case }
  3249.   TheMemoToAddTo.Visible := true;
  3250.   { Find total chars to output }
  3251.   TextLength := Length( TheTextToAdd );
  3252.   { If none then leave }
  3253.   if TextLength = 0 then exit;
  3254.   { Loop along the string }
  3255.   for Counter_1 := 1 to TextLength do
  3256.   begin
  3257.     { If hit ASCII 10 then assume end of line and output }
  3258.     if TheTextToAdd[ Counter_1 ] = #10 then
  3259.     begin
  3260.       { Use a try loop incase memo fills up }
  3261.       try
  3262.         { Add the line }
  3263.         TheMemoToAddTo.Lines.Add( TheLine );
  3264.       except
  3265.         { If memo fills up }
  3266.         on EOutOfResources do
  3267.         begin
  3268.           { Clear the old data }
  3269.           TheMemoToAddTo.Clear;
  3270.           { Output the new }
  3271.           TheMemoToAddTo.Lines.Add( TheLine );
  3272.         end;
  3273.       end;
  3274.       { clear the output buffer }
  3275.       TheLine := '';
  3276.     end
  3277.     else
  3278.     { Otherwise look for null terminator from Winsock }
  3279.     begin
  3280.       { If don't hit null terminator then add the char to op buffer }
  3281.       if TheTextToAdd[ Counter_1 ] <> #0 then
  3282.       begin
  3283.         TheLine := TheLine + TheTextToAdd[ Counter_1 ];
  3284.       end
  3285.       else break; { Otherwise drop out of the loop }
  3286.     end;
  3287.   end;
  3288. end;
  3289.  
  3290. { This function scans a line of UNIX-style text for #10's and }
  3291. { outputs the first line as its return value,stopping at #0.  }
  3292. function TCCINetCCForm.AddNullTermTextToLabel( TheTextToAdd   : String ) : String;
  3293. var
  3294.   TheLine      : String;  { Buffer to output current line }
  3295.   TextLength ,            { Total chars to output         }
  3296.   Counter_1    : integer; { Loop Index                    }
  3297. begin
  3298.   { Clear output buffer }
  3299.   TheLine := '';
  3300.   { Find total chars to output }
  3301.   TextLength := Length( TheTextToAdd );
  3302.   { If none then leave }
  3303.   if TextLength = 0 then
  3304.   begin
  3305.     { Return nothing }
  3306.     Result := '';
  3307.     { Leave }
  3308.     exit;
  3309.   end;
  3310.   { Loop along the string }
  3311.   for Counter_1 := 1 to TextLength do
  3312.   begin
  3313.     { If hit ASCII 10 then assume end of line and output }
  3314.     if TheTextToAdd[ Counter_1 ] = #10 then
  3315.     begin
  3316.       { Return first line }
  3317.       Result := TheLine;
  3318.       { Leave }
  3319.       exit;
  3320.     end
  3321.     else
  3322.     { Otherwise look for null terminator from Winsock }
  3323.     begin
  3324.       { If don't hit null terminator then add the char to op buffer }
  3325.       if TheTextToAdd[ Counter_1 ] <> #0 then
  3326.       begin
  3327.         TheLine := TheLine + TheTextToAdd[ Counter_1 ];
  3328.       end
  3329.       else break; { Otherwise drop out of the loop }
  3330.     end;
  3331.   end;
  3332.   { If hit #0 before #10 return buffer }
  3333.   Result := TheLine;
  3334. end;
  3335.  
  3336. { Show busy cursors }
  3337. procedure TCCINetCCForm.SetHGCursors;
  3338. begin
  3339.   CCInetCCForm.Cursor := crHourGlass;
  3340.   CCInetCCForm.Memo1.Cursor := crHourGlass;
  3341. end;
  3342.  
  3343. { Show normal cursors }
  3344. procedure TCCINetCCForm.SetNormalCursors;
  3345. begin
  3346.   CCInetCCForm.Cursor := crDefault;
  3347.   CCInetCCForm.Memo1.Cursor := crDefault;
  3348. end;
  3349.  
  3350. { Exit method }
  3351. procedure TCCINetCCForm.Exit1Click(Sender: TObject);
  3352. begin
  3353.   Close;
  3354. end;
  3355.  
  3356. { This method adds a line to the progress text stringlist  }
  3357. { If an exception occurs, the list is full, and it is auto }
  3358. { saved to the progress text file name, then cleared.      }
  3359. procedure TCCINetCCForm.AddProgressText( WhatText : String );
  3360. begin
  3361.   { Use a try..except loop to catch list overflows }
  3362.   try
  3363.     { Try the normal add }
  3364.     ProgressList.Add( WhatText );
  3365.   except
  3366.     { Any list error is assumed to be a list overflow }
  3367.     on EListError do
  3368.     begin
  3369.       { Save the list to the preset file name }
  3370.       ProgressList.SaveToFile( ProgressFileName );
  3371.       { Clear the list to make more room }
  3372.       ProgressList.Clear;
  3373.       { And redo the add; any further errors will except normally }
  3374.       ProgressList.Add( WhatText );
  3375.     end;
  3376.     { This might happen too! }
  3377.     on EOutOfResources do
  3378.     begin
  3379.       { Save the list to the preset file name }
  3380.       ProgressList.SaveToFile( ProgressFileName );
  3381.       { Clear the list to make more room }
  3382.       ProgressList.Clear;
  3383.       { And redo the add; any further errors will except normally }
  3384.       ProgressList.Add( WhatText );
  3385.     end;
  3386.   end;
  3387. end;
  3388.  
  3389. { This method either adds the progress line to the current memo }
  3390. { or puts it in the status caption at normal colors.            }
  3391. procedure TCCINetCCForm.ShowProgressText( WhatText : String );
  3392. begin
  3393.   { Use the POV to determine where to show progress info }
  3394.   case ProgressOutputVector of
  3395.     POV_MEMO : begin { Output into the memo  }
  3396.                  AddNullTermTextToMemo( WhatText , Memo1 );
  3397.                end;
  3398.     POV_STAT : begin { Output on status line }
  3399.                  { Set panel caption font to black }
  3400.                  Panel1.Font.Color := clBlack;
  3401.                  { Get the first line of text and put in caption }
  3402.                  Panel1.Caption := AddNullTermTextToLabel( WhatText );
  3403.                end;
  3404.   end;
  3405. end;
  3406.  
  3407. { This method is identical with SPT except sets status color to red and beeps }
  3408. procedure TCCINetCCForm.ShowProgressErrorText( WhatText : String );
  3409. begin
  3410.   { Do error beep }
  3411.   MessageBeep( mb_IconExclamation );
  3412.   { Use the POV to determine where to show progress info }
  3413.   case ProgressOutputVector of
  3414.     POV_MEMO : begin { Output into the memo  }
  3415.                  AddNullTermTextToMemo( WhatText , Memo1 );
  3416.                end;
  3417.     POV_STAT : begin { Output on status line }
  3418.                  { Set panel caption font to black }
  3419.                  Panel1.Font.Color := clRed;
  3420.                  { Get the first line of text and put in caption }
  3421.                  Panel1.Caption := AddNullTermTextToLabel( WhatText );
  3422.                end;
  3423.   end;
  3424. end;
  3425.  
  3426. { This is the boilerplate method used to handle Socket errors gracefully }
  3427. procedure TCCINetCCForm.SocketsErrorOccurred( Sender     : TObject;
  3428.                                               ErrorCode  : Integer;
  3429.                                               TheMessage : String   );
  3430. begin
  3431.   { Set the global error code flag }
  3432.   GlobalErrorCode := ErrorCode;
  3433.   { If a timeout error }
  3434.   if ErrorCode = WSAETIMEDOUT then
  3435.   begin
  3436.     { Set the aborted flag }
  3437.     GlobalAbortedFlag := True;
  3438.     { But clear the error code for graceful handling }
  3439.     GlobalErrorCode := 0;
  3440.   end
  3441.   else
  3442.   begin
  3443.     { Otherwise set the progress buffer to the error message }
  3444.     AddProgressText( TheMessage );
  3445.     { And show the progress text as set by option }
  3446.     ShowProgressErrorText( TheMessage );
  3447.   end;
  3448. end;
  3449.  
  3450. procedure TCCINetCCForm.FormCreate(Sender: TObject);
  3451. begin
  3452.   { Create the progress string list }
  3453.   ProgressList := TStringList.Create;
  3454.   { Create the file name for saving the progress list }
  3455.   ProgressFileName := ExpandFileName( 'PROGRESS.TXT' );
  3456.   { Default progress output to status line }
  3457.   ProgressOutputVector := POV_STAT;
  3458.   { Set password control stuff }
  3459.   PasswordControlVector := 2;
  3460.   CurrentPasswordString := 'guest@nowhere.com';
  3461.   CurrentRealPWString := 'guest@nowhere.com';
  3462.   NewMessageInProgress := false;
  3463.   EmailLoaded := false;
  3464.   NewsGroupListLoaded := false;
  3465.   { Get Ini file Data }
  3466.   ReadIniData;
  3467.   LoadFTPSiteFile;
  3468.   LoadNNTPSiteFile;
  3469.   TheFTPComponent := TFTPComponent.Create( CCInetCCForm );
  3470.   TheFTPComponent.Parent := CCInetCCForm;
  3471.   TheNNTPComponent := TNNTPComponent.Create( CCInetCCForm );
  3472.   TheNNTPComponent.Parent := CCInetCCForm;
  3473.   TheUUObject := TUUCodingObject.Create( Self );
  3474.   TheUUObject.Parent := self;
  3475. end;
  3476.  
  3477. procedure TCCINetCCForm.FormDestroy(Sender: TObject);
  3478. begin
  3479.   { Free the progress text stringlist if assigned }
  3480.   if assigned( ProgressList ) then ProgressList.Free;
  3481.   { Save off the Ini data }
  3482.   WriteIniData;
  3483.   { Save and remove FTP site list stuff }
  3484.   SaveFTPSiteFile;
  3485.   SaveNNTPSiteFile;
  3486.   if Assigned( TheFTPComponent ) then TheFTPComponent.Free;
  3487.   if Assigned( TheNNTPComponent ) then TheNNTPComponent.Free;
  3488.   if Assigned( TheUUObject ) then TheUUObject.Free;
  3489. end;
  3490.  
  3491. procedure TCCINetCCForm.Description1Click(Sender: TObject);
  3492. var
  3493.   TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  3494.   TheData    : String;    { Holder for data                           }
  3495. begin
  3496.   { Create socket; auto calls WSAStartup }
  3497.   TempSocket := TCCSocket.Create( Self );
  3498.   { Do parent just for kicks; no longer needed }
  3499.   TempSocket.Parent := self;
  3500.   { Put in error handler }
  3501.   TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  3502.   TheData := StrPas( TempSocket.Socket_WSA_Data.Description_String );
  3503.   { Display the Description String }
  3504.   AddProgressText( TheData );
  3505.   { And show the progress text as set by option }
  3506.   ShowProgressText( TheData );
  3507.   { Free the socket; auto calls WSACleanup }
  3508.   TempSocket.Free;
  3509. end;
  3510.  
  3511. procedure TCCINetCCForm.SystemStatus1Click(Sender: TObject);
  3512. var
  3513.   TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  3514.   TheData    : String;    { Holder for data                           }
  3515. begin
  3516.   { Create socket; auto calls WSAStartup }
  3517.   TempSocket := TCCSocket.Create( Self );
  3518.   { Do parent just for kicks; no longer needed }
  3519.   TempSocket.Parent := self;
  3520.   { Put in error handler }
  3521.   TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  3522.   TheData := StrPas( TempSocket.Socket_WSA_Data.System_Status_String );
  3523.   { Display the Description String }
  3524.   AddProgressText( TheData );
  3525.   { And show the progress text as set by option }
  3526.   ShowProgressText( TheData );
  3527.   { Free the socket; auto calls WSACleanup }
  3528.   TempSocket.Free;
  3529. end;
  3530.  
  3531. procedure TCCINetCCForm.VendorSpecific1Click(Sender: TObject);
  3532. var
  3533.   TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  3534.   TheData    : String;    { Holder for data                           }
  3535. begin
  3536.   { Create socket; auto calls WSAStartup }
  3537.   TempSocket := TCCSocket.Create( Self );
  3538.   { Do parent just for kicks; no longer needed }
  3539.   TempSocket.Parent := self;
  3540.   { Put in error handler }
  3541.   TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  3542.   TheData := StrPas( TempSocket.Socket_WSA_Data.Vendor_Specific_String );
  3543.   { Display the Description String }
  3544.   AddProgressText( TheData );
  3545.   { And show the progress text as set by option }
  3546.   ShowProgressText( TheData );
  3547.   { Free the socket; auto calls WSACleanup }
  3548.   TempSocket.Free;
  3549. end;
  3550.  
  3551. { This method sets the progress output vector to the memo }
  3552. procedure TCCINetCCForm.ViewInEditWindow1Click(Sender: TObject);
  3553. begin
  3554.   { Set the vector }
  3555.   ProgressOutputVector := POV_MEMO;
  3556.   { Keep the menu options consistent }
  3557.   ViewInEditWindow1.Checked := true;
  3558.   ViewInStatusLine1.Checked := false;
  3559. end;
  3560.  
  3561. { This method sets the progress output vector to the status line }
  3562. procedure TCCINetCCForm.ViewInStatusLine1Click(Sender: TObject);
  3563. begin
  3564.   { Set the vector }
  3565.   ProgressOutputVector := POV_STAT;
  3566.   { Keep the menus consistent }
  3567.   ViewInEditWindow1.Checked := false;
  3568.   ViewInStatusLine1.Checked := true;
  3569. end;
  3570.  
  3571. procedure TCCINetCCForm.SaveToFile1Click(Sender: TObject);
  3572. begin
  3573.   { Set up the dialog parameters }
  3574.   OpenDialog1.Filename := ProgressFileName;
  3575.   OpenDialog1.Title := 'Select Filename for Progress File';
  3576.   OpenDialog1.Filter := 'Text Files|*.txt';
  3577.   { If the dialog is not cancelled then save and clear }
  3578.   if OpenDialog1.Execute then
  3579.   begin
  3580.     ProgressFileName := OpenDialog1.FileName;
  3581.     ProgressList.SaveToFile( ProgressFileName );
  3582.     ProgressList.Clear;
  3583.   end;
  3584. end;
  3585.  
  3586. procedure TCCINetCCForm.IPAddress1Click(Sender: TObject);
  3587. begin
  3588.   { Set up info dialog for IP Address getting }
  3589.   CCICInfoDlg.Caption := 'CC Internet Center -- Translate IP Address';
  3590.   CCICInfoDlg.Panel4.Visible := false;
  3591.   CCICInfoDlg.Panel6.Visible := false;
  3592.   CCICInfoDlg.Panel9.Visible := false;
  3593.   CCICInfoDlg.Panel8.Visible := false;
  3594.   CCICInfoDlg.BitBtn2.Visible := false;
  3595.   CCICInfoDlg.Button1.Caption := 'Get IP Address';
  3596.   CCICInfoDlg.Button2.Visible := false;
  3597.   CCICInfoDlg.Button3.Visible := false;
  3598.   CCICInfoDlg.Button4.Visible := false;
  3599.   CCICInfoDlg.Panel2.Caption := 'IP Addr Name:';
  3600.   CCICInfoDlg.Panel3.Caption := '    Dotted Dec:';
  3601.   CCICInfoDlg.Panel5.Caption := '           Binary:';
  3602.   CCICInfoDlg.Edit1.Text := '';
  3603.   CCICInfoDlg.Edit2.Text := '';
  3604.   CCICInfoDlg.Edit3.Text := '';
  3605.   { Set IP Address Mode }
  3606.   CCICInfoDlg.Tag := 1;
  3607.   { Show Modally to get the information }
  3608.   CCICInfoDlg.ShowModal;
  3609.   { Reset the info dialog to default conditions }
  3610.   CCICInfoDlg.Caption := 'CC Internet Command Center Information Dialog';
  3611.   CCICInfoDlg.Panel4.Visible := true;
  3612.   CCICInfoDlg.Panel6.Visible := true;
  3613.   CCICInfoDlg.Panel9.Visible := true;
  3614.   CCICInfoDlg.Panel8.Visible := true;
  3615.   CCICInfoDlg.BitBtn2.Visible := true;
  3616.   CCICInfoDlg.Button1.Caption := 'Anonymous Login';
  3617.   CCICInfoDlg.Button2.Visible := true;
  3618.   CCICInfoDlg.Button3.Visible := true;
  3619.   CCICInfoDlg.Button4.Visible := true;
  3620.   CCICInfoDlg.Panel2.Caption := '             Name:';
  3621.   CCICInfoDlg.Panel3.Caption := '    IP Address:';
  3622.   CCICInfoDlg.Panel5.Caption := ' User Name:';
  3623.   CCICInfoDlg.Edit1.Text := '';
  3624.   CCICInfoDlg.Edit2.Text := '';
  3625.   CCICInfoDlg.Edit3.Text := '';
  3626. end;
  3627.  
  3628. procedure TCCINetCCForm.FTP1Click(Sender: TObject);
  3629. begin
  3630.   { Set up the FTP Data displays }
  3631.   SetupFTPSiteLists;
  3632.   ListBox1.Clear;
  3633.   ListBox2.Clear;
  3634. end;
  3635.  
  3636. procedure TCCINetCCForm.FormResize(Sender: TObject);
  3637. begin
  3638.   { Use tag vector to determine what to do }
  3639.   case Tag of
  3640.     { if FTP , make sure two list boxes are same height }
  3641.     2 : begin
  3642.           Panel6.Height := (( Panel4.Height div 2 ) - 30 );
  3643.           Panel4.Width := 185;
  3644.         end;
  3645.     4 : begin
  3646.           Panel6.Height := 118;
  3647.           Panel4.Width := 250;
  3648.         end;
  3649.   end;
  3650. end;
  3651.  
  3652. procedure TCCINetCCForm.FTPSites1Click(Sender: TObject);
  3653. begin
  3654.   { Show Modally to get the information }
  3655.   CCICInfoDlg.ShowModal;
  3656. end;
  3657.  
  3658. procedure TCCINetCCForm.FTP3Click(Sender: TObject);
  3659. begin
  3660.   CCICPrefsDlg.TabbedNoteBook1.PageIndex := 1;
  3661.   CCICPrefsDlg.Tag := 2;
  3662.   CCICPrefsDlg.ShowModal;
  3663. end;
  3664.  
  3665. procedure TCCINetCCForm.ConnectToSite1Click(Sender: TObject);
  3666. var Counter_1 : Integer;
  3667. begin
  3668.   if Lowercase( PConnectionsRecord( TheFTPSiteList.Items[
  3669.    ComboBox1.ItemIndex ] )^.CUserName ) = 'anonymous' then
  3670.   begin
  3671.     for Counter_1 := 1 to TheAnonRedialVector do
  3672.     begin
  3673.       DoFTPConnection( PConnectionsRecord(
  3674.          TheFTPSiteList.Items[ ComboBox1.ItemIndex ] ));
  3675.       if TheFTPComponent.Connection_Established then exit;
  3676.     end;
  3677.   end
  3678.   else DoFTPConnection( PConnectionsRecord(
  3679.    TheFTPSiteList.Items[ ComboBox1.ItemIndex ] ));
  3680. end;
  3681.  
  3682. procedure TCCINetCCForm.Button1Click(Sender: TObject);
  3683. begin
  3684.   case Tag of
  3685.     2 : begin
  3686.           if not TheFTPComponent.Connection_Established then
  3687.            ConnectToSite1Click( Self ) else
  3688.            begin
  3689.              DoFTPDisconnect;
  3690.              TheFTPComponent.Connection_Established := false;
  3691.              DisableFTPMenus;
  3692.            end;
  3693.         end;
  3694.     4 : begin
  3695.           ConnectAndUpdate1Click( Self );
  3696.         end;
  3697.     5 : begin
  3698.           GetMarked1Click( Self );
  3699.         end;
  3700.   end;
  3701. end;
  3702.  
  3703. procedure TCCINetCCForm.ViewasText1Click(Sender: TObject);
  3704. begin
  3705.   { Assume valid FTP component and have it send its text into the progress text}
  3706.   TheFTPComponent.GetRemoteDirectoryListingToMemo;
  3707. end;
  3708.  
  3709. procedure TCCINetCCForm.Disconnect1Click(Sender: TObject);
  3710. begin
  3711.   DoFTPDisconnect;
  3712.   DisableFTPMenus;
  3713. end;
  3714.  
  3715. procedure TCCINetCCForm.EnableFTPMenus;
  3716. begin
  3717.   Button1.Caption := 'Disconnect';
  3718.   ConnectToSite1.Enabled := false;
  3719.   Disconnect1.Enabled := true;
  3720.   Directory1.Enabled := true;
  3721.   UploadMarked1.Enabled := true;
  3722.   DownloadMarked1.Enabled := true;
  3723. end;
  3724.  
  3725. procedure TCCINetCCForm.DisableFTPMenus;
  3726. begin
  3727.   Button1.Caption := 'Connect';
  3728.   ConnectToSite1.Enabled := true;
  3729.   Disconnect1.Enabled := false;
  3730.   Directory1.Enabled := false;
  3731.   UploadMarked1.Enabled := false;
  3732.   DownloadMarked1.Enabled := false;
  3733.   FTP1.Enabled := true;
  3734.   UseNetNws1.Enabled := true;
  3735.   IPAddress1.Enabled := true;
  3736.   FTP2.Enabled := false;
  3737. end;
  3738.  
  3739. procedure TCCINetCCForm.EnableNNTPMenus;
  3740. begin
  3741.   Button1.Caption := 'Disconnect';
  3742.   ConnectAndUpdate1.Enabled := false;
  3743.   Disconnect2.Enabled := true;
  3744.   CheckNewNews1.Enabled := true;
  3745.   GetMarked1.Enabled := true;
  3746.   Article1.Enabled := true;
  3747.   Post1.Enabled := true;
  3748.   SubScribedNewsgroups1.Enabled := true;
  3749.   Trash1.Enabled := true;
  3750.   Headers1.Enabled := true;
  3751.   DownLoadActiveNewsGroups1.Enabled := true;
  3752. end;
  3753.  
  3754. procedure TCCINetCCForm.DisableNNTPMenus;
  3755. begin
  3756.   Button1.Caption := 'Connect';
  3757.   ConnectAndUpdate1.Enabled := True;
  3758.   Disconnect2.Enabled := false;
  3759.   CheckNewNews1.Enabled := false;
  3760.   GetMarked1.Enabled := false;
  3761.   Article1.Enabled := false;
  3762.   Post1.Enabled := false;
  3763.   SubScribedNewsgroups1.Enabled := false;
  3764.   Trash1.Enabled := false;
  3765.   Headers1.Enabled := false;
  3766.   DownLoadActiveNewsGroups1.Enabled := false;
  3767. end;
  3768.  
  3769. procedure TCCINetCCForm.ToDisplay1Click(Sender: TObject);
  3770. var Counter_1 : Integer;
  3771. begin
  3772.   for Counter_1 := 0 to Listbox1.Items.Count - 1 do
  3773.   begin
  3774.     if Listbox1.Selected[ Counter_1 ] then
  3775.     begin
  3776.       FileNameToXFer := ListBox1.Items[ Counter_1 ];
  3777.       TheFTPComponent.
  3778.        ReceiveASCIIRemoteFileToMemo( Listbox1.Items[ Counter_1 ] );
  3779.     end;
  3780.   end;
  3781. end;
  3782.  
  3783. procedure TCCINetCCForm.ToFile1Click(Sender: TObject);
  3784. var Counter_1 : Integer;
  3785.     W16Name   : String;
  3786. begin
  3787.   for Counter_1 := 0 to Listbox1.Items.Count - 1 do
  3788.   begin
  3789.     if Listbox1.Selected[ Counter_1 ] then
  3790.     begin
  3791.       FileNameToXFer := ListBox1.Items[ Counter_1 ];
  3792.       W16Name := TheFTPComponent.GetWin16Filename( FileNameToXFer );
  3793.       TheFTPComponent.
  3794.        ReceiveASCIIRemoteFile( Listbox1.Items[ Counter_1 ] , W16Name );
  3795.     end;
  3796.   end;
  3797. end;
  3798.  
  3799. procedure TCCINetCCForm.Binary2Click(Sender: TObject);
  3800. var Counter_1 : Integer;
  3801.     W16Name   : String;
  3802. begin
  3803.   for Counter_1 := 0 to Listbox1.Items.Count - 1 do
  3804.   begin
  3805.     if Listbox1.Selected[ Counter_1 ] then
  3806.     begin
  3807.       FileNameToXFer := ListBox1.Items[ Counter_1 ];
  3808.       W16Name := TheFTPComponent.GetWin16Filename( FileNameToXFer );
  3809.       TheFTPComponent.
  3810.        ReceiveBinaryRemoteFile( Listbox1.Items[ Counter_1 ] , W16Name );
  3811.     end;
  3812.   end;
  3813. end;
  3814.  
  3815. procedure TCCINetCCForm.Change1Click(Sender: TObject);
  3816. var TheDir : String;
  3817. begin
  3818.   if ListBox1.ItemIndex = -1 then exit;
  3819.   TheDir := ListBox1.Items[ ListBox1.ItemIndex ];
  3820.   if TheFTPComponent.SetRemoteDirectory( TheDir ) then
  3821.   begin
  3822.     TheFTPComponent.GetRemoteWorkingDirectory( TheDir ); 
  3823.     { Put up remote directory via PWD and strip quotes }
  3824.     Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  3825.     { Get the listings of directories and exit OK }
  3826.     TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  3827.   end;
  3828. end;
  3829.  
  3830. procedure TCCINetCCForm.ChangeLocal1Click(Sender: TObject);
  3831. var TheDir : String;
  3832. begin
  3833.   if ListBox2.ItemIndex = -1 then exit;
  3834.   TheDir := ListBox2.Items[ ListBox2.ItemIndex ];
  3835.   TheDir := TheFTPComponent.StripBrackets( TheDir );
  3836.   if TheDir = '..' then
  3837.   begin
  3838.     ChDir( TheDir );
  3839.   end
  3840.   else
  3841.   begin
  3842.     TheDir := ExpandFileName( TheDir );
  3843.     ChDir( TheDir );
  3844.   end;
  3845.   TheFTPComponent.GetLocalDirectoryAndListing( TheDir , Listbox2 );
  3846.   if Label5.Canvas.TextWidth( TheDir ) > Label5.Width then
  3847.    TheDir := TheFTPComponent.GetShortPathName( TheDir );
  3848.   Label5.Caption := TheDir;
  3849. end;
  3850.  
  3851. procedure TCCINetCCForm.ListBox1DblClick(Sender: TObject);
  3852. begin
  3853.   case Tag of
  3854.     2 : begin
  3855.           case DefaultDownLoadVector of
  3856.             1 : Binary2Click( Self );
  3857.             2 : ToFile1Click( Self );
  3858.             3 : Change1Click( Self );
  3859.           end;
  3860.         end;
  3861.   end;
  3862. end;
  3863.  
  3864. procedure TCCINetCCForm.ListBox2DblClick(Sender: TObject);
  3865. var WorkingString ,
  3866.     NumberString    : String;
  3867.     TheIDNumber     : Integer;
  3868.     TheNGARecord    : PNewsGroupArticleRecord;
  3869. begin
  3870.   case Tag of
  3871.     2 : begin
  3872.           case DefaultDownLoadVector of
  3873.             1 : Binary1Click( Self );
  3874.             2 : ASCII1Click( Self );
  3875.             3 : ChangeLocal1Click( Self );
  3876.           end;
  3877.         end;
  3878.     5 : begin
  3879.           if ListBox2.Tag <> 5 then exit;
  3880.           if ListBox2.ItemIndex = -1 then exit;
  3881.           WorkingString := ListBox2.Items[ ListBox2.ItemIndex ];
  3882.           NumberString := TheFTPComponent.StripBrackets( WorkingString );
  3883.           TheIDNumber := StrToInt( NumberString );
  3884.           TheNGARecord := PNewsGroupArticleRecord(
  3885.            TheNGArticlesList.Items[ TheIDNumber ] );
  3886.           if TheNGARecord^.NGADownloaded then
  3887.           begin
  3888.             Memo1.Clear;
  3889.             try
  3890.               Memo1.Lines.LoadFromFile( NewsPath + '\' + TheNGARecord^.NGAArtFileName );
  3891.             except
  3892.               MessageDlg( 'Article Too Large to Load! Use Write to View [' +
  3893.                TheNGARecord^.NGAArtFilename + '.',
  3894.                mtError,[mbOK],0);
  3895.               exit;
  3896.             end;
  3897.             Label1.Caption := 'Subject:';
  3898.             ComboBox1.Text := TheNGARecord^.NGASubject;
  3899.             TheNGARecord^.NGARead := true;
  3900.             WorkingString := ListBox2.Items[ ListBox2.ItemIndex ];
  3901.             WorkingString[ 3 ] := 'R';
  3902.             ListBox2.Items[ ListBox2.ItemIndex ] := WorkingString;
  3903.           end
  3904.           else
  3905.           begin
  3906.             MessageDlg( 'Article Not Downloaded!',mtError,[mbOK],0);
  3907.           end;
  3908.         end;
  3909.   end;
  3910. end;
  3911.  
  3912. procedure TCCINetCCForm.ASCII1Click(Sender: TObject);
  3913. var Counter_1 : Integer;
  3914.     TheDir    : String;
  3915. begin
  3916.   for Counter_1 := 0 to Listbox2.Items.Count - 1 do
  3917.   begin
  3918.     if Listbox2.Selected[ Counter_1 ] then
  3919.     begin
  3920.       FileNameToXFer := ListBox2.Items[ Counter_1 ];
  3921.       TheFTPComponent.
  3922.        SendASCIILocalFile( Listbox2.Items[ Counter_1 ] );
  3923.     end;
  3924.   end;
  3925.   TheFTPComponent.GetRemoteWorkingDirectory( TheDir );
  3926.   { Put up remote directory via PWD and strip quotes }
  3927.   Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  3928.   { Get the listings of directories and exit OK }
  3929.   TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  3930. end;
  3931.  
  3932. procedure TCCINetCCForm.DeleteRemoteFiles1Click(Sender: TObject);
  3933. var Counter_1 : Integer;
  3934.     TheDir    : String;
  3935.     DoAll     : Boolean;
  3936.     TheResult : Integer;
  3937. begin
  3938.   DoAll := false;
  3939.   for Counter_1 := 0 to Listbox1.Items.Count - 1 do
  3940.   begin
  3941.     if Listbox1.Selected[ Counter_1 ] then
  3942.     begin
  3943.       if not DoAll then
  3944.       begin
  3945.         TheResult := MessageDlg( 'Delete Remote File ' +
  3946.          ListBox1.Items[ Counter_1 ] + ' ?',mtConfirmation,
  3947.           [mbYes,mbNo,mbCancel,mbAll],0 );
  3948.         case TheResult of
  3949.           mrYes : ;
  3950.           mrNo  : ;
  3951.           mrCancel : break;
  3952.           mrAll : begin
  3953.                     TheResult := mrYes;
  3954.                     DoAll := true;
  3955.                   end;
  3956.         end;
  3957.       end
  3958.       else TheResult := mrYes;
  3959.       if TheResult = mrYes then TheFTPComponent.
  3960.          DeleteRemoteFile( Listbox1.Items[ Counter_1 ] );
  3961.     end;
  3962.   end;
  3963.   TheFTPComponent.GetRemoteWorkingDirectory( TheDir );
  3964.   { Put up remote directory via PWD and strip quotes }
  3965.   Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  3966.   { Get the listings of directories and exit OK }
  3967.   TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  3968. end;
  3969.  
  3970. procedure TCCINetCCForm.Binary1Click(Sender: TObject);
  3971. var Counter_1 : Integer;
  3972.     TheDir    : String;
  3973. begin
  3974.   for Counter_1 := 0 to Listbox2.Items.Count - 1 do
  3975.   begin
  3976.     if Listbox2.Selected[ Counter_1 ] then
  3977.     begin
  3978.       FileNameToXFer := ListBox2.Items[ Counter_1 ];
  3979.       TheFTPComponent.
  3980.        SendBinaryLocalFile( Listbox2.Items[ Counter_1 ] );
  3981.     end;
  3982.   end;
  3983.   TheFTPComponent.GetRemoteWorkingDirectory( TheDir );
  3984.   { Put up remote directory via PWD and strip quotes }
  3985.   Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  3986.   { Get the listings of directories and exit OK }
  3987.   TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  3988. end;
  3989.  
  3990. procedure TCCINetCCForm.Delete3Click(Sender: TObject);
  3991. var Counter_1 : Integer;
  3992.     TheDir    : String;
  3993. begin
  3994.   for Counter_1 := 0 to Listbox1.Items.Count - 1 do
  3995.   begin
  3996.     if Listbox1.Selected[ Counter_1 ] then
  3997.     begin
  3998.       if ListBox1.Items[ Counter_1 ] <> '..' then
  3999.        TheFTPComponent.
  4000.         DeleteRemoteDirectory( Listbox1.Items[ Counter_1 ] );
  4001.     end;
  4002.   end;
  4003.   TheFTPComponent.GetRemoteWorkingDirectory( TheDir );
  4004.   { Put up remote directory via PWD and strip quotes }
  4005.   Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  4006.   { Get the listings of directories and exit OK }
  4007.   TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  4008. end;
  4009.  
  4010. procedure TCCINetCCForm.Create1Click(Sender: TObject);
  4011. var TheDir : String;
  4012. begin
  4013.   OpenDialog1.Filename := '*.*';
  4014.   OpenDialog1.Title := 'Enter Remote Directory Name';
  4015.   if OpenDialog1.Execute then
  4016.   begin
  4017.     TheFTPComponent.
  4018.      CreateRemoteDirectory( ExtractFileName( OpenDialog1.FileName ));
  4019.     TheFTPComponent.GetRemoteWorkingDirectory( TheDir );
  4020.     { Put up remote directory via PWD and strip quotes }
  4021.     Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  4022.     { Get the listings of directories and exit OK }
  4023.     TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  4024.   end;
  4025. end;
  4026.  
  4027. procedure TCCINetCCForm.ListBox1Click(Sender: TObject);
  4028. var TheNGRecord : PNewsGroupRecord;
  4029. begin
  4030.   case ListBox1.Tag of
  4031.     5 : begin
  4032.           if ListBox1.ItemIndex = -1 then exit;
  4033.           TheNGRecord :=
  4034.            PNewsGroupRecord( TheNewsRCList.Items[ ListBox1.ItemIndex ] );
  4035.           TheNGArticlesList := TList( TheNGRecord^.GLTag );
  4036.           PopulateLB2WithArticleHeaders;
  4037.           ComboBox1.ItemIndex := ListBox1.ItemIndex;
  4038.         end;
  4039.   end;
  4040. end;
  4041.  
  4042. procedure TCCINetCCForm.UsenetNws1Click(Sender: TObject);
  4043. begin
  4044.   if TheFTPComponent.Connection_Established then
  4045.   begin
  4046.     MessageDlg( 'Must disconnect from current FTP session first!',
  4047.      mtError,[mbOK],0);
  4048.     exit;
  4049.   end;
  4050.   { Show The NNTP servers display }
  4051.   ListBox1.Clear;
  4052.   ListBox2.Clear;
  4053.   SetupNNTPSiteLists;
  4054.   NewsGroupListLoaded := false;
  4055.   SetupNNTPServersInfoDisplay;
  4056. end;
  4057.  
  4058. procedure TCCINetCCForm.Disconnect2Click(Sender: TObject);
  4059. begin
  4060.   SaveNNTPNewsGroupLists;
  4061.   DoNNTPDisconnect;
  4062.   DisableNNTPMenus;
  4063.   ListBox1.Clear;
  4064.   ListBox2.Clear;
  4065. end;
  4066.  
  4067. procedure TCCINetCCForm.News2Click(Sender: TObject);
  4068. begin
  4069.   CCICPrefsDlg.TabbedNoteBook1.PageIndex := 2;
  4070.   CCICPrefsDlg.Tag := 4;
  4071.   CCICPrefsDlg.ShowModal;
  4072. end;
  4073.  
  4074. procedure TCCINetCCForm.ConnectandUpdate1Click(Sender: TObject);
  4075. begin
  4076.   DoNNTPConnection( PConnectionsRecord(
  4077.      TheNewsServerList.Items[ ComboBox1.ItemIndex ] ));
  4078.   if TheNNTPComponent.Connection_Established then
  4079.   begin
  4080.     SetupNNTPNewsGroupLists;
  4081.     if NewsInitialUpdateVector = 1 then
  4082.     begin { Update all active newsgroups }
  4083.       TheNNTPComponent.CheckAllNewNews;
  4084.     end;
  4085.     { Bring up the files with current NG information }
  4086.     SetupNewsGroupListboxes;
  4087.   end;
  4088. end;
  4089.  
  4090. procedure TCCINetCCForm.CheckNewNews1Click(Sender: TObject);
  4091. begin
  4092.   TheNNTPComponent.CheckAllNewNews;
  4093.   SetupNewsGroupListboxes;
  4094. end;
  4095.  
  4096. procedure TCCINetCCForm.NewsServers1Click(Sender: TObject);
  4097. begin
  4098.   { Reset display to NNTP Servers }
  4099.   SetupNNTPServersInfoDisplay;
  4100.   { Show Modally to get the information }
  4101.   CCICInfoDlg.ShowModal;
  4102. end;
  4103.  
  4104. procedure TCCINetCCForm.SubscribedNewsgroups1Click(Sender: TObject);
  4105. begin
  4106.   { Reset display to Usenet Newsgroups }
  4107.   SetupNNTPNewsGroupsInfoDisplay;
  4108.   { Show Modally to get the information }
  4109.   CCICInfoDlg.ShowModal;
  4110.   TheNNTPComponent.CheckAllNewNews;
  4111.   SetupNewsGroupListboxes;
  4112. end;
  4113.  
  4114. procedure TCCINetCCForm.RetrieveMarked1Click(Sender: TObject);
  4115. var Counter_1   : Integer;
  4116.     TheNGRecord : PNewsGroupRecord;
  4117. begin
  4118.   for Counter_1 := 0 to ListBox1.Items.Count - 1 do
  4119.   begin
  4120.     TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] );
  4121.     if (( TheNGRecord^.GSubscribed ) and ( ListBox1.Selected[ Counter_1 ] )) then
  4122.     begin
  4123.       TheNNTPComponent.GetAllArticleHeaders( TheNGRecord );
  4124.     end;
  4125.   end;
  4126.   SetupNewsGroupListboxes;
  4127. end;
  4128.  
  4129. procedure TCCINetCCForm.RetrieveAll1Click(Sender: TObject);
  4130. var Counter_1   : Integer;
  4131.     TheNGRecord : PNewsGroupRecord;
  4132. begin
  4133.   for Counter_1 := 0 to TheNewsRCList.Count - 1 do
  4134.   begin
  4135.     TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] );
  4136.     if TheNGRecord^.GSubscribed then
  4137.     begin
  4138.       TheNNTPComponent.GetAllArticleHeaders( TheNGRecord );
  4139.     end;
  4140.   end;
  4141.   SetupNewsGroupListboxes;
  4142. end;
  4143.  
  4144. procedure TCCINetCCForm.GetMarked1Click(Sender: TObject);
  4145. var TheNGRecord : PNewsGroupRecord;
  4146. begin
  4147.   TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ ListBox1.ItemIndex ] );
  4148.   TheNNTPComponent.DownloadAllMarkedArticleListings( TheNGRecord , ListBox2 );
  4149.   SetupNewsGroupListboxes;
  4150. end;
  4151.  
  4152. procedure TCCINetCCForm.NewArticle1Click(Sender: TObject);
  4153. begin
  4154.   if ListBox1.ItemIndex = -1 then exit;
  4155.   Memo1.Clear;
  4156.   TheNNTPComponent.SetNewsHeaders( Memo1 , ListBox1.ItemIndex );
  4157. end;
  4158.  
  4159. procedure TCCINetCCForm.FollowupArticle1Click(Sender: TObject);
  4160. begin
  4161.   if ListBox1.ItemIndex = -1 then exit;
  4162.   if ListBox2.ItemIndex = -1 then exit;
  4163.   Memo1.Clear;
  4164.   TheNNTPComponent.SetFUNewsHeaders( Memo1              ,
  4165.                                      ListBox1.ItemIndex ,
  4166.                                      ListBox2.ItemIndex   );
  4167. end;
  4168.  
  4169. procedure TCCINetCCForm.PutinQueue1Click(Sender: TObject);
  4170. var TheNGRecord : PNewsGroupRecord;
  4171.     TheNGARecord : PNewsGroupArticleRecord;
  4172.     WorkingList : TList;
  4173.     WorkingFilename : String;
  4174.     Holdingposition : Integer;
  4175. begin
  4176.   TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ ListBox1.ItemIndex ] );
  4177.   WorkingList := TList( TheNGRecord^.GLTag );
  4178.   New( TheNGARecord );
  4179.   with TheNGARecord^ do
  4180.   begin
  4181.     NGAGroupname   := TheNGRecord^.GRealName;
  4182.     NGASubject     := TheNNTPComponent.GetHeaderSubject( TStringList( Memo1.Lines ));
  4183.     NGANumber      := TheNGRecord^.GHighestAvailable + WorkingList.Count;
  4184.     NGADownloaded  := true;
  4185.     NGASender      := 'CIUPKC158';
  4186.     NGARead        := false;
  4187.     NGAPosted      := false;
  4188.     WorkingFileName := 'AR' + IntToStr( NGANumber );
  4189.     if Length( WorkingFileName ) > 8 then
  4190.      WorkingFileName := Copy( WorkingFileName ,1 , 8 );
  4191.     WorkingFileName := WorkingFileName + '.' + IntToStr( TheNGRecord^.GIDNumber );
  4192.     NGAArtFileName := WorkingFileName;
  4193.   end;
  4194.   WorkingList.Add( TheNGARecord );
  4195.   Memo1.Lines.SaveToFile( NewsPath + '\' + WorkingFileName );
  4196.   HoldingPosition := ListBox1.itemindex;
  4197.   SetupNewsGroupListboxes;
  4198.   TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ HoldingPosition ] );
  4199.   TheNGArticlesList := TList( TheNGRecord^.GLTag );
  4200.   PopulateLB2WithArticleHeaders;
  4201. end;
  4202.  
  4203. procedure TCCINetCCForm.CurrentArticle1Click(Sender: TObject);
  4204. var TheNGARecord : PNewsGroupArticleRecord;
  4205.     TheNGRecord  : PNewsGroupRecord;
  4206.     HP : Integer;
  4207. begin
  4208.   HP := ListBox1.itemindex;
  4209.   PutInQueue1Click( Self );
  4210.   TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ HP ] );
  4211.   TheNGArticlesList := TList( TheNGRecord^.GLTag );
  4212.   TheNGARecord := PNewsGroupArticleRecord( TheNGArticlesList.Items[ TheNGArticlesList.Count - 1 ] );
  4213.   TheNNTPComponent.UploadArticleListing( TheNGARecord );
  4214. end;
  4215.  
  4216. procedure TCCINetCCForm.EntireQueue1Click(Sender: TObject);
  4217. var TheNGRecord : PNewsGroupRecord;
  4218. begin
  4219.   TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ ListBox1.ItemIndex ] );
  4220.   TheNNTPComponent.UploadAllArticleListings( TheNGRecord );
  4221. end;
  4222.  
  4223. procedure TCCINetCCForm.AllReadArticles1Click(Sender: TObject);
  4224. var TheNGRecord : PNewsGroupRecord;
  4225. begin
  4226.   TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ ListBox1.ItemIndex ] );
  4227.   TheNNTPComponent.PurgeReadSentArticleListings( TheNGRecord );
  4228.   SetupNewsGroupListboxes;
  4229. end;
  4230.  
  4231. procedure TCCINetCCForm.AllMarkedArticles1Click(Sender: TObject);
  4232. var TheNGRecord : PNewsGroupRecord;
  4233.     TheNGARecord : PNewsGroupArticleRecord;
  4234.     WorkingList : TList;
  4235.     Counter_1 : Integer;
  4236. begin
  4237.   TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ ListBox1.ItemIndex ] );
  4238.   WorkingList := TList( TheNGRecord^.GLTag );
  4239.   for Counter_1 := 0 to ListBox2.Items.Count - 1 do
  4240.   begin
  4241.     if ListBox2.Selected[ Counter_1 ] then
  4242.     begin
  4243.       TheNGARecord := PNewsGroupArticleRecord( WorkingList.Items[ Counter_1 ] );
  4244.       TheNGARecord^.NGARead := true;
  4245.     end;
  4246.   end;
  4247.   TheNNTPComponent.PurgeReadSentArticleListings( TheNGRecord );
  4248.   SetupNewsGroupListboxes;
  4249. end;
  4250.  
  4251. procedure TCCINetCCForm.AllAvailableArticles1Click(Sender: TObject);
  4252. var TheNGRecord : PNewsGroupRecord;
  4253.     TheNGARecord : PNewsGroupArticleRecord;
  4254.     WorkingList : TList;
  4255.     Counter_1  : Integer;
  4256. begin
  4257.   TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ ListBox1.ItemIndex ] );
  4258.   WorkingList := TList( TheNGRecord^.GLTag );
  4259.   for Counter_1 := 0 to ListBox2.Items.Count - 1 do
  4260.   begin
  4261.     TheNGARecord := PNewsGroupArticleRecord( WorkingList.Items[ Counter_1 ] );
  4262.     TheNGARecord^.NGARead := true;
  4263.   end;
  4264.   TheNNTPComponent.PurgeReadSentArticleListings( TheNGRecord );
  4265.   SetupNewsGroupListboxes;
  4266. end;
  4267.  
  4268. procedure TCCINetCCForm.DownloadActiveNewsgroups1Click(Sender: TObject);
  4269. begin
  4270.   if MessageDlg( 'This will take considerable time. Proceed?',mtConfirmation,
  4271.    mbYesNoCancel,0) = mrYes then
  4272.   begin
  4273.     Memo1.Clear;
  4274.     TheNNTPComponent.GetListofAvailableNewsGroups;
  4275.   end;
  4276. end;
  4277.  
  4278. procedure TCCINetCCForm.Load1Click(Sender: TObject);
  4279. var Memo2 : TMemo;
  4280.     Counter_1 : Integer;
  4281. begin
  4282.   OpenDialog1.Filename := '*.txt';
  4283.   OpenDialog1.Title := 'Select File to load into Memo';
  4284.   if OpenDialog1.Execute then
  4285.   begin
  4286.     Memo2 := TMemo.Create( Self );
  4287.     Memo2.Parent := Self;
  4288.     Memo2.Visible := false;
  4289.     Memo2.Width := Memo1.Width;
  4290.     Memo2.Height := Memo1.Height;
  4291.     Memo2.Lines.LoadFromFile( OpenDialog1.FileName );
  4292.     for Counter_1 := 0 to Memo2.Lines.Count - 1 do
  4293.      Memo1.Lines.Add( Memo2.Lines[ Counter_1 ] );
  4294.     Memo2.Free;
  4295.   end;
  4296. end;
  4297.  
  4298. procedure TCCINetCCForm.Save1Click(Sender: TObject);
  4299. begin
  4300.   SaveDialog1.Filename := '*.txt';
  4301.   SaveDialog1.Title := 'Select File to Save Memo to';
  4302.   if OpenDialog1.Execute then
  4303.   begin
  4304.     Memo1.Lines.SaveToFile( SaveDialog1.FileName );
  4305.   end;
  4306. end;
  4307.  
  4308. procedure TCCINetCCForm.Paths1Click(Sender: TObject);
  4309. begin
  4310.   CCICPrefsDlg.TabbedNoteBook1.PageIndex := 3;
  4311.   CCICPrefsDlg.Tag := 3;
  4312.   CCICPrefsDlg.ShowModal;
  4313. end;
  4314.  
  4315. procedure TCCINetCCForm.Cut1Click(Sender: TObject);
  4316. begin
  4317.   Memo1.CutToClipboard;
  4318. end;
  4319.  
  4320. procedure TCCINetCCForm.Copy1Click(Sender: TObject);
  4321. begin
  4322.   Memo1.CopyToClipboard;
  4323. end;
  4324.  
  4325. procedure TCCINetCCForm.CopytoFile1Click(Sender: TObject);
  4326. var TempMemo : TMemo;
  4327. begin
  4328.   TempMemo := TMemo.Create( self );
  4329.   TempMemo.parent := self;
  4330.   Tempmemo.Visible := false;
  4331.   TempMemo.Width := Memo1.Width;
  4332.   TempMemo.Height := Memo1.Height;
  4333.   Memo1.CopyToClipboard;
  4334.   TempMemo.PasteFromClipboard;
  4335.   SaveDialog1.Filename := '*.TXT';
  4336.   SaveDialog1.Title := 'Select File to Save To';
  4337.   if SaveDialog1.Execute then TempMemo.Lines.SaveToFile( SaveDialog1.Filename );
  4338.   TempMemo.Free;
  4339. end;
  4340.  
  4341. procedure TCCINetCCForm.Paste1Click(Sender: TObject);
  4342. begin
  4343.   Memo1.PasteFromClipboard;
  4344. end;
  4345.  
  4346. procedure TCCINetCCForm.PastefromFile1Click(Sender: TObject);
  4347. var TempMemo : TMemo;
  4348. begin
  4349.   TempMemo := TMemo.Create( self );
  4350.   TempMemo.parent := self;
  4351.   Tempmemo.Visible := false;
  4352.   TempMemo.Width := Memo1.Width;
  4353.   TempMemo.Height := Memo1.Height;
  4354.   OpenDialog1.Filename := '*.*';
  4355.   OpenDialog1.Title := 'Select File to Paste From';
  4356.   if OpenDialog1.Execute then TempMemo.Lines.LoadFromFile( OpenDialog1.Filename );
  4357.   TempMemo.SelectAll;
  4358.   TempMemo.CopyToClipboard;
  4359.   Memo1.PasteFromClipboard;
  4360.   TempMemo.Free;
  4361. end;
  4362.  
  4363. procedure TCCINetCCForm.SpeedButton5Click(Sender: TObject);
  4364. begin
  4365.   case Tag of
  4366.     5 : AllMarkedArticles1Click( Self );
  4367.   end;
  4368. end;
  4369.  
  4370. procedure TCCINetCCForm.SpeedButton1Click(Sender: TObject);
  4371. begin
  4372.   case Tag of
  4373.     5 : begin
  4374.           if ListBox2.Items.Count = 0 then exit;
  4375.           Listbox2.multiselect := false;
  4376.           If ListBox2.ItemIndex = -1 then ListBox2.ItemIndex := 0;
  4377.           ListBox2.ItemIndex := Listbox2.ItemIndex - 1;
  4378.           if ListBox2.Itemindex < 0 then
  4379.            Listbox2.Itemindex := ListBox2.Items.Count - 1;
  4380.           ListBox2DblClick( Self );
  4381.           ListBox2.Multiselect := true;
  4382.           ListBox2.SetFocus;
  4383.         end;
  4384.   end;
  4385. end;
  4386.  
  4387. procedure TCCINetCCForm.SpeedButton2Click(Sender: TObject);
  4388. begin
  4389.   case Tag of
  4390.     5 : begin
  4391.           if ListBox2.Items.Count = 0 then exit;
  4392.           ListBox2.MultiSelect := false;
  4393.           If ListBox2.ItemIndex = -1 then ListBox2.ItemIndex := 0;
  4394.           ListBox2.ItemIndex := Listbox2.ItemIndex + 1;
  4395.           if ListBox2.Itemindex > ListBox2.Items.Count - 1 then
  4396.            Listbox2.Itemindex := 0;
  4397.           ListBox2DblClick( Self );
  4398.           ListBox2.MultiSelect := true;
  4399.           ListBox2.SetFocus;
  4400.         end;
  4401.   end;
  4402. end;
  4403.  
  4404. procedure TCCINetCCForm.ListBox2Click(Sender: TObject);
  4405. var TheWorkingList : TList;
  4406.     TheNGARecord : PNewsGroupArticleRecord;
  4407.     TheNGRecord : PNewsGroupRecord;
  4408.     TheWorkingName : String;
  4409. begin
  4410.   if ListBox2.Tag = 9 then
  4411.   begin
  4412.     TheNGRecord :=
  4413.      PNewsGroupRecord( TheNewsRCList.Items[ ListBox1.ItemIndex ] );
  4414.     TheWorkingList := TList( TheNGRecord^.GLTag );
  4415.     TheNGARecord := PNewsGroupArticleRecord(
  4416.      TheWorkingList.Items[ ListBox2.ItemIndex ] );
  4417.     TheWorkingName := NewsPath + '\' + TheNGARecord^.NGAArtFileName;
  4418.     TheUUDecodeList.Add( TheWorkingName );
  4419.     exit;
  4420.   end;
  4421.   case Tag of
  4422.     5 : begin
  4423.           If ListBox2.Items.Count = 0 then exit;
  4424.           ComboBox1.Text := ListBox2.Items[ ListBox2.ItemIndex ];
  4425.         end;
  4426.   end;
  4427. end;
  4428.  
  4429. procedure TCCINetCCForm.AbortNewsgroupDownload1Click(Sender: TObject);
  4430. begin
  4431.   GlobalAbortedFlag := true;
  4432. end;
  4433.  
  4434. procedure TCCINetCCForm.Marked1Click(Sender: TObject);
  4435. var Counter_1,
  4436.     Counter_2   : Integer;
  4437.     TheNGRecord : PNewsGroupRecord;
  4438.     TheNGARecord : PNewsGroupArticleRecord;
  4439.     WorkingList : TList;
  4440. begin
  4441.   for Counter_1 := 0 to ListBox1.Items.Count - 1 do
  4442.   begin
  4443.     TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] );
  4444.     if (( TheNGRecord^.GSubscribed ) and ( ListBox1.Selected[ Counter_1 ] )) then
  4445.     begin
  4446.       WorkingList := TList( TheNGRecord^.GLTag );
  4447.       for Counter_2 := 0 to ListBox2.Items.Count - 1 do
  4448.       begin
  4449.         TheNGARecord := PNewsGroupArticleRecord( WorkingList.Items[ Counter_2 ] );
  4450.         TheNGARecord^.NGARead := true;
  4451.       end;
  4452.       TheNNTPComponent.PurgeReadSentArticleListings( TheNGRecord );
  4453.       TheNGRecord^.GLowest := TheNGRecord^.GHighestAvailable;
  4454.       TheNGRecord^.GHighest := TheNGRecord^.GLowest;
  4455.       TheNGRecord^.GTotalNew := 0;
  4456.       TheNGRecord^.GTotalArticles := 0;
  4457.     end;
  4458.   end;
  4459.   SetupNewsGroupListboxes;
  4460. end;
  4461.  
  4462. procedure TCCINetCCForm.All1Click(Sender: TObject);
  4463. var Counter_1,
  4464.     Counter_2   : Integer;
  4465.     TheNGRecord : PNewsGroupRecord;
  4466.     TheNGARecord : PNewsGroupArticleRecord;
  4467.     WorkingList : TList;
  4468. begin
  4469.   for Counter_1 := 0 to ListBox1.Items.Count - 1 do
  4470.   begin
  4471.     TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] );
  4472.     if TheNGRecord^.GSubscribed then
  4473.     begin
  4474.       WorkingList := TList( TheNGRecord^.GLTag );
  4475.       for Counter_2 := 0 to ListBox2.Items.Count - 1 do
  4476.       begin
  4477.         TheNGARecord := PNewsGroupArticleRecord( WorkingList.Items[ Counter_2 ] );
  4478.         TheNGARecord^.NGARead := true;
  4479.       end;
  4480.       TheNGRecord^.GLowest := TheNGRecord^.GHighestAvailable;
  4481.       TheNGRecord^.GHighest := TheNGRecord^.GLowest;
  4482.       TheNGRecord^.GTotalNew := 0;
  4483.       TheNGRecord^.GTotalArticles := 0;
  4484.       TheNNTPComponent.PurgeReadSentArticleListings( TheNGRecord );
  4485.     end;
  4486.   end;
  4487.   SetupNewsGroupListboxes;
  4488. end;
  4489.  
  4490. procedure TCCINetCCForm.File1Click(Sender: TObject);
  4491. begin
  4492.   OpenDialog1.Filename := '*.uue';
  4493.   OpenDialog1.Filter := 'UUEncode Files|*.uue|All Files *.*';
  4494.   OpenDialog1.Title := 'Select File To Decode';
  4495.   if OpenDialog1.Execute then
  4496.   begin
  4497.     TheUUObject.SetInputFileName( OpenDialog1.FileName );
  4498.     TheUUObject.SetMultifileVector( CMV_SINGLE );
  4499.     TheUUObject.Decode;
  4500.   end;
  4501. end;
  4502.  
  4503. procedure TCCINetCCForm.SelectedArticle1Click(Sender: TObject);
  4504. var TheWorkingList : TList;
  4505.     TheNGARecord : PNewsGroupArticleRecord;
  4506.     TheNGRecord : PNewsGroupRecord;
  4507.     TheWorkingName : String;
  4508. begin
  4509.   TheNGRecord :=
  4510.    PNewsGroupRecord( TheNewsRCList.Items[ ListBox1.ItemIndex ] );
  4511.   TheWorkingList := TList( TheNGRecord^.GLTag );
  4512.   TheNGARecord := PNewsGroupArticleRecord(
  4513.    TheWorkingList.Items[ ListBox2.ItemIndex ] );
  4514.   TheWorkingName := NewsPath + '\' + TheNGARecord^.NGAArtFileName;
  4515.   TheUUObject.SetInputFileName( TheWorkingName );
  4516.   TheUUObject.SetMultifileVector( CMV_SINGLE );
  4517.   TheUUObject.Decode;
  4518. end;
  4519.  
  4520. procedure TCCINetCCForm.SelectMultipleArticles1Click(Sender: TObject);
  4521. begin
  4522.   { Set tag so that listbox knows to keep track of hits}
  4523.   ListBox2.Tag := 9;
  4524.   ListBox2.MultiSelect := false;
  4525.   TheUUDecodeList := TStringList.Create;
  4526. end;
  4527.  
  4528. procedure TCCINetCCForm.DecodeSelections1Click(Sender: TObject);
  4529. begin
  4530.   ListBox2.Tag := 5;
  4531.   ListBox2.MultiSelect := True;
  4532.   if TheUUDecodeList.Count = 0 then exit;
  4533.   TheUUObject.SetMultipleFilesList( TheUUDecodeList );
  4534.   TheUUObject.SetMultifileVector( CMV_MULTI );
  4535.   TheUUObject.Decode;
  4536.   TheUUDecodeList.Free;
  4537. end;
  4538.  
  4539. procedure TCCINetCCForm.SpeedButton4Click(Sender: TObject);
  4540. begin
  4541.   case Tag of
  4542.     5 : begin
  4543.           SelectedArticle1Click( Self );
  4544.         end;
  4545.   end;
  4546. end;
  4547.  
  4548. end.
  4549.  
  4550.